summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/scripts/fontools/afm2afm
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2012-04-16 23:15:11 +0000
committerKarl Berry <karl@freefriends.org>2012-04-16 23:15:11 +0000
commite8a389a2d60b6ff53118a05f72c266fc3bd725b0 (patch)
treea684b2e593b0f7cede10362be9fe321f733e1acc /Master/texmf-dist/scripts/fontools/afm2afm
parentc3c415e17085b0a75a89e652d576f6a943a41649 (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-xMaster/texmf-dist/scripts/fontools/afm2afm458
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>