summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/scripts/fontools
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2013-08-07 23:16:42 +0000
committerKarl Berry <karl@freefriends.org>2013-08-07 23:16:42 +0000
commitdc5e48b09a868b75a4eb7b33c6563434818be35b (patch)
tree98ece6f7d54e4d54372c81bb17f081748bd6a695 /Master/texmf-dist/scripts/fontools
parentf08589b3e35bcf3f75b93226b3f914b76b76afe9 (diff)
fontools (7aug13)
git-svn-id: svn://tug.org/texlive/trunk@31378 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/scripts/fontools')
-rwxr-xr-xMaster/texmf-dist/scripts/fontools/afm2afm89
-rwxr-xr-xMaster/texmf-dist/scripts/fontools/ot2kpx258
2 files changed, 194 insertions, 153 deletions
diff --git a/Master/texmf-dist/scripts/fontools/afm2afm b/Master/texmf-dist/scripts/fontools/afm2afm
index 87d6ef1bbb4..997e195d7f4 100755
--- a/Master/texmf-dist/scripts/fontools/afm2afm
+++ b/Master/texmf-dist/scripts/fontools/afm2afm
@@ -4,7 +4,7 @@
----------------------------------------------------------------------------
- Copyright (C) 2005-2012 Marc Penninga.
+ Copyright (C) 2005-2013 Marc Penninga.
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
@@ -37,11 +37,17 @@ use File::Basename;
use Getopt::Long;
use Pod::Usage;
-use v5.10;
-
parse_commandline();
my $afm = read_afm($ARGV[0]);
+$afm->{kernpairs} = read_kpx($ARGV{kpx}, $afm->{kernpairs}) if $ARGV{kpx};
+
+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;
+}
# If user specified encoding, use that; else, use encoding from .afm file
my $enc = $ARGV{encoding} ? read_enc($ARGV{encoding})
@@ -62,30 +68,24 @@ print_mapentry($afm->{fontinfo}, , $enc->{scheme})
if $ARGV{encoding} && $ARGV{output};
#-----------------------------------------------------------------------
-#
+# Read the command-line options
#-----------------------------------------------------------------------
sub parse_commandline {
Getopt::Long::GetOptions(
'help|?' => sub { pod2usage(-verbose => 1) },
'encoding=s' => \$ARGV{encoding},
+ 'kpx=s' => \$ARGV{kpx},
'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;
}
#-----------------------------------------------------------------------
-#
+# Read the input afm file
#-----------------------------------------------------------------------
sub read_afm {
my $filename = shift;
@@ -105,10 +105,10 @@ sub read_afm {
}
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}}, $_ }
+ if (m/\A\s* C \s/xms) { push @{$afm{metrics}}, $_; next }
+ if (m/\A\s* KPX \s/xms) { push @{$afm{kernpairs}}, $_; next }
+ if (m/\A\s* TrackKern \s/xms) { push @{$afm{trackkerns}}, $_; next }
+ if (m/\A\s* CC \s/xms) { push @{$afm{composites}}, $_; next }
}
close $afmfile;
@@ -117,6 +117,24 @@ sub read_afm {
}
#-----------------------------------------------------------------------
+# Read additional kerning pairs from the kpx file
+#-----------------------------------------------------------------------
+sub read_kpx {
+ my ($filename, $kpx) = @_;
+ open my $kpxfile, '<', $filename
+ or die "[ERROR] can't open '$filename': $!";
+
+ my %seen = map { ($_ => 1) } @$kpx;
+ for (<$kpxfile>) {
+ if (m/\A\s* KPX \s/xms) { push @$kpx, $_ unless $seen{$_}++ }
+ }
+
+ close $kpxfile;
+
+ return $kpx;
+}
+
+#-----------------------------------------------------------------------
# Get encoding name and vector from the specified .enc file
#-----------------------------------------------------------------------
sub read_enc {
@@ -161,7 +179,7 @@ sub get_enc {
}
#-----------------------------------------------------------------------
-#
+# Print the 'fontinfo' part of the output afm file
#-----------------------------------------------------------------------
sub print_fontinfo {
my ($fontinfo, $scheme) = @_;
@@ -253,7 +271,7 @@ sub print_composites {
}
#-----------------------------------------------------------------------
-#
+# Print a mapfile entry for this re-encoded font
#-----------------------------------------------------------------------
sub print_mapentry {
my ($fontinfo, $scheme) = @_;
@@ -300,6 +318,7 @@ afm2afm - reencode an F<afm> file
[B<-help>]
[B<-encoding> I<encodingfile>]
+[B<-kpx> I<kpxfile>]
[B<-output> I<outputfile>]
B<afmfile>
@@ -312,10 +331,12 @@ 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.
+(potentially much) smaller 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.
+Additional kerning pairs can be added to the output file.
+If you don't specify an encoding file,
+the F<afm> file isn't re-encoded;
+however, all unused (unencoded) data is still pruned.
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
@@ -335,6 +356,19 @@ Print a short description of the syntax
Re-encode to the enconding in I<encodingfile>
+=item B<-kpx> I<kpxfile>
+
+Read additional kerning pairs from I<kpxfile> and add these to the output.
+This option cannot be used to override values from the input F<afm> file,
+since B<afm2afm> will write both old and new values to the output!
+
+The I<kpxfile> should contain kerning data in standard F<afm> format,
+i.e. for each kerning pair there should be a line
+
+ KPX <left_glyph> <right_glyph> <amount>
+
+All other lines in the I<kpxfile> are ignored.
+
=item B<-output> I<outputfile>
Write the result to I<outputfile> instead of C<stdout>.
@@ -345,7 +379,8 @@ The F<afm> file to be re-encoded.
=back
-Option names may be shortened to a unique prefix.
+You may use either one or two dashes before options,
+and option names may be shortened to a unique prefix.
=head1 AUTHOR
@@ -355,7 +390,7 @@ Marc Penninga <marcpenninga@gmail.com>
=head1 COPYRIGHT
-Copyright (C) 2005-2012 Marc Penninga.
+Copyright (C) 2005-2013 Marc Penninga.
=head1 LICENSE
@@ -364,7 +399,7 @@ 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>;
+A copy of the GNU General Public License is included with B<afm2afm>;
see the file F<GPLv2.txt>.
@@ -382,6 +417,12 @@ See the GNU General Public License for more details.
=over 12
+=item I<2013-08-07>
+
+Added the I<-kpx> command-line option.
+Replaced all C<given/when> constructions in the source code by C<if>'s,
+to avoid warnings about experimental features in Perl 5.18 and later.
+
=item I<2012-02-01>
Refactored the code; added the "no re-encoding, only pruning"
diff --git a/Master/texmf-dist/scripts/fontools/ot2kpx b/Master/texmf-dist/scripts/fontools/ot2kpx
index 60c2a99b418..707f9b6bd22 100755
--- a/Master/texmf-dist/scripts/fontools/ot2kpx
+++ b/Master/texmf-dist/scripts/fontools/ot2kpx
@@ -4,7 +4,7 @@
----------------------------------------------------------------------------
- Copyright (C) 2005-2012 Marc Penninga.
+ Copyright (C) 2005-2013 Marc Penninga.
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
@@ -37,8 +37,6 @@ use integer;
use List::Util @List::Util::EXPORT_OK;
use Pod::Usage;
-use v5.10;
-
our ($NUM_GLYPHS, $UNITS_PER_EM, %KPX);
sub main {
@@ -67,12 +65,14 @@ sub main {
for my $subtable (@subtables) {
my $pos_format = unpack 'n', $subtable;
- given ($pos_format) {
- when (1) { OTF::GPOS::parse_pos_format_1($subtable) }
- when (2) { OTF::GPOS::parse_pos_format_2($subtable) }
- default {
- warn "[ERROR] invalid PosFormat $pos_format ignored";
- }
+ if ($pos_format == 1) {
+ OTF::GPOS::parse_pos_format_1($subtable);
+ }
+ elsif ($pos_format == 2) {
+ OTF::GPOS::parse_pos_format_2($subtable);
+ }
+ else {
+ warn "[ERROR] invalid PosFormat $pos_format ignored";
}
}
}
@@ -278,37 +278,35 @@ sub get_glyph_names {
my $charset = substr $CFF, $top_dict{15};
my $format = unpack 'C', $charset;
- given ($format) {
- when (0) {
- my @codes = unpack "\@1n@{[ $NUM_GLYPHS - 1 ]}", $charset;
- @$glyph_name = @strings[0, @codes];
- }
- when (1) {
- my $i = 0;
- $glyph_name->[$i++] = $strings[0];
- for (my $j = 0; $i < $NUM_GLYPHS; $j++) {
- my ($first, $n_left)
- = unpack "\@@{[ 1 + 3*$j ]}nC", $charset;
- $glyph_name->[$i + $_] = $strings[$first + $_]
- for 0 .. $n_left;
- $i += 1 + $n_left;
- }
- }
- when (2) {
- my $i = 0;
- $glyph_name->[$i++] = $strings[0];
- for (my $j = 0; $i < $NUM_GLYPHS; $j++) {
- my ($first, $n_left)
- = unpack "\@@{[ 1 + 4*$j ]}nn", $charset;
- $glyph_name->[$i + $_] = $strings[$first + $_]
- for 0 .. $n_left;
- $i += 1 + $n_left;
- }
+ if ($format == 0) {
+ my @codes = unpack "\@1n@{[ $NUM_GLYPHS - 1 ]}", $charset;
+ @$glyph_name = @strings[0, @codes];
+ }
+ elsif ($format == 1) {
+ my $i = 0;
+ $glyph_name->[$i++] = $strings[0];
+ for (my $j = 0; $i < $NUM_GLYPHS; $j++) {
+ my ($first, $n_left)
+ = unpack "\@@{[ 1 + 3*$j ]}nC", $charset;
+ $glyph_name->[$i + $_] = $strings[$first + $_]
+ for 0 .. $n_left;
+ $i += 1 + $n_left;
}
- default {
- warn "[ERROR] invalid CharsetFormat '$format' ignored";
+ }
+ elsif ($format == 2) {
+ my $i = 0;
+ $glyph_name->[$i++] = $strings[0];
+ for (my $j = 0; $i < $NUM_GLYPHS; $j++) {
+ my ($first, $n_left)
+ = unpack "\@@{[ 1 + 4*$j ]}nn", $charset;
+ $glyph_name->[$i + $_] = $strings[$first + $_]
+ for 0 .. $n_left;
+ $i += 1 + $n_left;
}
}
+ else {
+ warn "[ERROR] invalid CharsetFormat '$format' ignored";
+ }
return;
}
@@ -321,20 +319,18 @@ sub _parse_index {
my ($count, $off_size) = unpack 'nC', $index;
my @offsets = unpack "\@3(a$off_size)@{[ $count + 1 ]}", $index;
- given ($off_size) {
- when (1) { $_ = unpack 'C', $_ for @offsets }
- when (2) { $_ = unpack 'n', $_ for @offsets }
- when (4) { $_ = unpack 'N', $_ for @offsets }
- when (3) {
- for my $offset (@offsets) {
- my @bytes = map 'C3', $offset;
- $offset = ($bytes[0] << 16) + ($bytes[1] << 8) + $bytes[2];
- }
- }
- default {
- warn "[ERROR] invalid OffSize $off_size ignored";
+ if ($off_size == 1) { $_ = unpack 'C', $_ for @offsets }
+ elsif ($off_size == 2) { $_ = unpack 'n', $_ for @offsets }
+ elsif ($off_size == 4) { $_ = unpack 'N', $_ for @offsets }
+ elsif ($off_size == 3) {
+ for my $offset (@offsets) {
+ my @bytes = map 'C3', $offset;
+ $offset = ($bytes[0] << 16) + ($bytes[1] << 8) + $bytes[2];
}
}
+ else {
+ warn "[ERROR] invalid OffSize $off_size ignored";
+ }
$_ += 2 + $off_size * ($count + 1) for @offsets;
my @data;
@@ -355,24 +351,28 @@ sub _parse_dict {
my @bytes = unpack 'C*', $dict;
my (@operands, %dict);
while (@bytes) {
- given ($bytes[0]) {
- when ([0 .. 11, 13 .. 22]) {
- my $operator = shift @bytes;
- ($dict{$operator} = join q{ }, @operands) =~ s/^\s+//xms;
- @operands = ();
- }
- when (12) {
- my $operator = join q{ }, splice @bytes, 0, 2;
- ($dict{$operator} = join q{ }, @operands) =~ s/^\s+//xms;
- @operands = ();
- }
- when ([28, 29, 30, 32 .. 254]) {
- push @operands, _get_number(\@bytes);
- }
- default {
- warn "[ERROR] invalid byte $bytes[0] in DICT ignored";
- shift @bytes;
- }
+ if (( 0 <= $bytes[0] && $bytes[0] <= 11)
+ || (13 <= $bytes[0] && $bytes[0] <= 22))
+ {
+ my $operator = shift @bytes;
+ ($dict{$operator} = join q{ }, @operands) =~ s/^\s+//xms;
+ @operands = ();
+ }
+ elsif ($bytes[0] == 12) {
+ my $operator = join q{ }, splice @bytes, 0, 2;
+ ($dict{$operator} = join q{ }, @operands) =~ s/^\s+//xms;
+ @operands = ();
+ }
+ elsif ($bytes[0] == 28
+ || $bytes[0] == 29
+ || $bytes[0] == 30
+ || (32 <= $bytes[0] && $bytes[0] <= 254))
+ {
+ push @operands, _get_number(\@bytes);
+ }
+ else {
+ warn "[ERROR] invalid byte $bytes[0] in DICT ignored";
+ shift @bytes;
}
}
@@ -385,33 +385,32 @@ sub _parse_dict {
sub _get_number {
my $bytes = shift;
- given (my $b0 = shift @$bytes) {
- when (28) {
- my ($b1, $b2) = splice @$bytes, 0, 2;
- return ($b1 << 8) | $b2;
- }
- when (29) {
- my ($b1, $b2, $b3, $b4) = splice @$bytes, 0, 4;
- return ((((($b1 << 8) + $b2) << 8) + $b3) << 8) + $b4;
- }
- when (30) {
- # Reals not implemented; just dump appropriate number of bytes
- until (($b0 & 0xf0) == 0xf0 || ($b0 & 0xf) == 0xf) {
- $b0 = shift @$bytes;
- }
- }
- when ([ 32 .. 246]) {
- return $b0 - 139;
- }
- when ([247 .. 250]) {
- my $b1 = shift @$bytes;
- return 256 * ($b0 - 247) + $b1 + 108;
- }
- when ([251 .. 254]) {
- my $b1 = shift @$bytes;
- return -256 * ($b0 - 251) - $b1 - 108;
+ my $b0 = shift @$bytes;
+ if ($b0 == 28) {
+ my ($b1, $b2) = splice @$bytes, 0, 2;
+ return ($b1 << 8) | $b2;
+ }
+ elsif ($b0 == 29) {
+ my ($b1, $b2, $b3, $b4) = splice @$bytes, 0, 4;
+ return ((((($b1 << 8) + $b2) << 8) + $b3) << 8) + $b4;
+ }
+ elsif ($b0 == 30) {
+ # Reals not implemented; just dump appropriate number of bytes
+ until (($b0 & 0xf0) == 0xf0 || ($b0 & 0xf) == 0xf) {
+ $b0 = shift @$bytes;
}
}
+ elsif (32 <= $b0 && $b0 <= 246) {
+ return $b0 - 139;
+ }
+ elsif (247 <= $b0 && $b0 <= 250) {
+ my $b1 = shift @$bytes;
+ return 256 * ($b0 - 247) + $b1 + 108;
+ }
+ elsif (251 <= $b0 && $b0 <= 254) {
+ my $b1 = shift @$bytes;
+ return -256 * ($b0 - 251) - $b1 - 108;
+ }
}
@@ -559,24 +558,22 @@ sub _get_class {
my @class = (0) x $NUM_GLYPHS;
my $class_format = unpack 'n', $class;
- given ($class_format) {
- when (1) {
- my ($start_glyph, @class_value) = unpack '@2nn/n', $class;
- @class[$start_glyph .. $start_glyph + $#class_value]
- = @class_value;
- }
- when (2) {
- my @class_ranges = unpack '@2n/(a6)', $class;
- for my $class_range (@class_ranges) {
- my ($start, $end, $class) = unpack 'nnn', $class_range;
- @class[$start .. $end] = ($class) x ($end - $start + 1);
- }
- }
- default {
- warn "[ERROR] invalid ClassFormat '$class_format' ignored";
- return;
+ if ($class_format == 1) {
+ my ($start_glyph, @class_value) = unpack '@2nn/n', $class;
+ @class[$start_glyph .. $start_glyph + $#class_value]
+ = @class_value;
+ }
+ elsif ($class_format == 2) {
+ my @class_ranges = unpack '@2n/(a6)', $class;
+ for my $class_range (@class_ranges) {
+ my ($start, $end, $class) = unpack 'nnn', $class_range;
+ @class[$start .. $end] = ($class) x ($end - $start + 1);
}
}
+ else {
+ warn "[ERROR] invalid ClassFormat '$class_format' ignored";
+ return;
+ }
return @class;
}
@@ -611,21 +608,19 @@ sub _get_coverage {
my $coverage = shift;
my $coverage_format = unpack 'n', $coverage;
- given ($coverage_format) {
- when (1) {
- return unpack '@2n/n', $coverage;
- }
- when (2) {
- my @range_records = unpack '@2n/(a6)', $coverage;
+ if ($coverage_format == 1) {
+ return unpack '@2n/n', $coverage;
+ }
+ elsif ($coverage_format == 2) {
+ my @range_records = unpack '@2n/(a6)', $coverage;
- return map { my ($start, $end) = unpack 'nn', $_;
- $start .. $end;
- }
- @range_records;
- }
- default {
- warn "[WARNING] unknown CoverageFormat $coverage_format ignored";
- }
+ return map { my ($start, $end) = unpack 'nn', $_;
+ $start .. $end;
+ }
+ @range_records;
+ }
+ else {
+ warn "[WARNING] unknown CoverageFormat $coverage_format ignored";
}
}
@@ -731,12 +726,12 @@ multiple fonts, LookupTables with LookupTypes other than 2,
"kern" tables with format other than 0 and ValueRecords with
other types of data than just XAdvance data.
-Most of these limitations don't really matter, since the missing features
+Most of these limitations won't matter, since the missing features
are rare (the only fonts I know of that use them are the non-western fonts
-that come with Adobe Reader). Furthermore, some of these features concern
-(according to the OpenType specification) I<"define subtle, device-dependent
-adjustments at specific font sizes or device resolutions">.
-Since there's no way to express such adjustments in F<afm> format,
+that come with Adobe Reader). Furthermore, many of these features define
+(according to the OpenType specification) I<"subtle, device-dependent
+adjustments at specific font sizes or device resolutions">;
+since there's no way to express such adjustments in F<afm> format,
ignoring them seems to be the only option anyway.
=item B<->
@@ -776,7 +771,7 @@ Marc Penninga <marcpenninga@gmail.com>
=head1 COPYRIGHT
-Copyright (C) 2005-2012 Marc Penninga.
+Copyright (C) 2005-2013 Marc Penninga.
=head1 LICENSE
@@ -785,7 +780,7 @@ 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>;
+A copy of the GNU General Public License is included with B<ot2kpx>;
see the file F<GPLv2.txt>.
@@ -803,6 +798,11 @@ See the GNU General Public License for more details.
=over 12
+=item I<2013-08-07>
+
+Replaced all C<given/when> constructions in the source code by C<if>'s,
+to avoid warnings about experimental features in Perl 5.18 and later.
+
=item I<2012-02-01>
Refactored the code, and fixed a number of bugs in the process.