From dc5e48b09a868b75a4eb7b33c6563434818be35b Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Wed, 7 Aug 2013 23:16:42 +0000 Subject: fontools (7aug13) git-svn-id: svn://tug.org/texlive/trunk@31378 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf-dist/scripts/fontools/afm2afm | 89 +++++++--- Master/texmf-dist/scripts/fontools/ot2kpx | 258 ++++++++++++++--------------- 2 files changed, 194 insertions(+), 153 deletions(-) (limited to 'Master/texmf-dist/scripts') 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; @@ -116,6 +116,24 @@ sub read_afm { return \%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 #----------------------------------------------------------------------- @@ -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 file [B<-help>] [B<-encoding> I] +[B<-kpx> I] [B<-output> I] B @@ -312,10 +331,12 @@ B re-encodes an F 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 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 file isn't re-encoded; +however, all unused (unencoded) data is still pruned. The program also generates an entry for a F-style map file, but only if the F file has been re-encoded and @@ -335,6 +356,19 @@ Print a short description of the syntax Re-encode to the enconding in I +=item B<-kpx> I + +Read additional kerning pairs from I and add these to the output. +This option cannot be used to override values from the input F file, +since B will write both old and new values to the output! + +The I should contain kerning data in standard F format, +i.e. for each kerning pair there should be a line + + KPX + +All other lines in the I are ignored. + =item B<-output> I Write the result to I instead of C. @@ -345,7 +379,8 @@ The F 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 =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; +A copy of the GNU General Public License is included with B; see the file F. @@ -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 constructions in the source code by C'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 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 format, ignoring them seems to be the only option anyway. =item B<-> @@ -776,7 +771,7 @@ Marc Penninga =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; +A copy of the GNU General Public License is included with B; see the file F. @@ -803,6 +798,11 @@ See the GNU General Public License for more details. =over 12 +=item I<2013-08-07> + +Replaced all C constructions in the source code by C'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. -- cgit v1.2.3