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 --- .../texk/texlive/linked_scripts/fontools/afm2afm | 89 +++++-- .../texk/texlive/linked_scripts/fontools/ot2kpx | 258 ++++++++++----------- .../texk/texlive/linked_scripts/texlive/tlmgr.pl | 19 +- .../texk/texlive/linked_scripts/texlive/updmap.pl | 29 ++- Master/texmf-dist/doc/man/man1/afm2afm.1 | 37 ++- Master/texmf-dist/doc/man/man1/afm2afm.man1.pdf | Bin 5402 -> 7070 bytes Master/texmf-dist/doc/man/man1/autoinst.man1.pdf | Bin 29895 -> 29895 bytes Master/texmf-dist/doc/man/man1/ot2kpx.1 | 20 +- Master/texmf-dist/doc/man/man1/ot2kpx.man1.pdf | Bin 7543 -> 7798 bytes Master/texmf-dist/doc/support/fontools/README | 2 +- Master/texmf-dist/scripts/fontools/afm2afm | 89 +++++-- Master/texmf-dist/scripts/fontools/ot2kpx | 258 ++++++++++----------- 12 files changed, 464 insertions(+), 337 deletions(-) diff --git a/Build/source/texk/texlive/linked_scripts/fontools/afm2afm b/Build/source/texk/texlive/linked_scripts/fontools/afm2afm index 87d6ef1bbb4..997e195d7f4 100755 --- a/Build/source/texk/texlive/linked_scripts/fontools/afm2afm +++ b/Build/source/texk/texlive/linked_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/Build/source/texk/texlive/linked_scripts/fontools/ot2kpx b/Build/source/texk/texlive/linked_scripts/fontools/ot2kpx index 60c2a99b418..707f9b6bd22 100755 --- a/Build/source/texk/texlive/linked_scripts/fontools/ot2kpx +++ b/Build/source/texk/texlive/linked_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. diff --git a/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl b/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl index 526db1e9b59..d3594dc39d9 100755 --- a/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl +++ b/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl @@ -1,12 +1,12 @@ #!/usr/bin/env perl -# $Id: tlmgr.pl 31259 2013-07-21 22:07:38Z karl $ +# $Id: tlmgr.pl 31361 2013-08-06 01:50:48Z preining $ # # Copyright 2008-2013 Norbert Preining # This file is licensed under the GNU General Public License version 2 # or any later version. -my $svnrev = '$Revision: 31259 $'; -my $datrev = '$Date: 2013-07-22 00:07:38 +0200 (Mon, 22 Jul 2013) $'; +my $svnrev = '$Revision: 31361 $'; +my $datrev = '$Date: 2013-08-06 03:50:48 +0200 (Tue, 06 Aug 2013) $'; my $tlmgrrevision; my $prg; if ($svnrev =~ m/: ([0-9]+) /) { @@ -3370,6 +3370,14 @@ END_DISK_WARN sub action_install { init_local_db(1); return if !check_on_writable(); + + # + # installation from a .tar.xz + if ($opts{"file"}) { + return $localtlpdb->install_package_files(@ARGV); + } + + # if we are still here, we are installing from some repository # initialize the TLPDB from $location $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"}; init_tlmedia_or_die(); @@ -3391,11 +3399,6 @@ sub action_install { } } - # - # installation from a .tar.xz - if ($opts{"file"}) { - return $localtlpdb->install_package_files(@ARGV); - } $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"}; info("install: dry run, no changes will be made\n") if $opts{"dry-run"}; diff --git a/Build/source/texk/texlive/linked_scripts/texlive/updmap.pl b/Build/source/texk/texlive/linked_scripts/texlive/updmap.pl index 4444a177f2a..54db7e1a3d9 100755 --- a/Build/source/texk/texlive/linked_scripts/texlive/updmap.pl +++ b/Build/source/texk/texlive/linked_scripts/texlive/updmap.pl @@ -1,5 +1,5 @@ #!/usr/bin/env perl -# $Id: updmap.pl 30150 2013-04-28 23:33:28Z karl $ +# $Id: updmap.pl 31320 2013-07-31 01:49:38Z preining $ # updmap - maintain map files for outline fonts. # (Maintained in TeX Live:Master/texmf-dist/scripts/texlive.) # @@ -34,7 +34,7 @@ BEGIN { } -my $version = '$Id: updmap.pl 30150 2013-04-28 23:33:28Z karl $'; +my $version = '$Id: updmap.pl 31320 2013-07-31 01:49:38Z preining $'; use Getopt::Long qw(:config no_autoabbrev ignore_case_always); use strict; @@ -53,24 +53,32 @@ reset_root_home(); chomp(my $TEXMFDIST = `kpsewhich --var-value=TEXMFDIST`); chomp(my $TEXMFVAR = `kpsewhich -var-value=TEXMFVAR`); +chomp(my $TEXMFSYSVAR = `kpsewhich -var-value=TEXMFSYSVAR`); chomp(my $TEXMFCONFIG = `kpsewhich -var-value=TEXMFCONFIG`); +chomp(my $TEXMFSYSCONFIG = `kpsewhich -var-value=TEXMFSYSCONFIG`); chomp(my $TEXMFHOME = `kpsewhich -var-value=TEXMFHOME`); # make sure that on windows *everything* is in lower case for comparison if (win32()) { $TEXMFDIST = lc($TEXMFDIST); $TEXMFVAR = lc($TEXMFVAR); + $TEXMFSYSVAR = lc($TEXMFSYSVAR); $TEXMFCONFIG = lc($TEXMFCONFIG); + $TEXMFSYSCONFIG = lc($TEXMFSYSCONFIG); $TEXMFROOT = lc($TEXMFROOT); $TEXMFHOME = lc($TEXMFHOME); } +my $texmfconfig = $TEXMFCONFIG; +my $texmfvar = $TEXMFVAR; + my %opts = ( quiet => 0, nohash => 0, nomkmap => 0 ); my $alldata; my $updLSR; my @cmdline_options = ( + "sys", "listfiles", "cnffile=s@", "copy", @@ -157,6 +165,12 @@ sub main { exit (0); } + if ($opts{'sys'}) { + # we are running as updmap-sys, make sure that the right tree is used + $texmfconfig = $TEXMFSYSCONFIG; + $texmfvar = $TEXMFSYSVAR; + } + if ($opts{'dvipdfmoutputdir'} && !defined($opts{'dvipdfmxoutputdir'})) { $opts{'dvipdfmxoutputdir'} = $opts{'dvipdfmoutputdir'}; printf STDERR "Using --dvipdfmoutputdir options for dvipdfmx, but please use --dvipdfmxoutputdir\n"; @@ -283,7 +297,7 @@ sub main { # if none of the two exists, create a file in TEXMFCONFIG and use it my $use_top = 0; for my $f (@used_files) { - if ($f =~ m!(\Q$TEXMFHOME\E|\Q$TEXMFCONFIG\E)/web2c/updmap.cfg!) { + if ($f =~ m!(\Q$TEXMFHOME\E|\Q$texmfconfig\E)/web2c/updmap.cfg!) { $use_top = 1; last; } @@ -292,7 +306,7 @@ sub main { ($changes_config_file) = @used_files; } else { # add the empty config file - my $dn = "$TEXMFCONFIG/web2c"; + my $dn = "$texmfconfig/web2c"; $changes_config_file = "$dn/updmap.cfg"; } } @@ -925,10 +939,10 @@ sub get_cfg { sub mkMaps { my $logfile; - $logfile = "$TEXMFVAR/web2c/updmap.log"; + $logfile = "$texmfvar/web2c/updmap.log"; if (! $opts{'dry-run'}) { - mkdirhier("$TEXMFVAR/web2c"); + mkdirhier("$texmfvar/web2c"); open LOG, ">$logfile" or die "$prg: Can't open log file \"$logfile\": $!"; print LOG &version(); @@ -1292,7 +1306,7 @@ sub setupOutputDir { if ($opts{'outputdir'}) { $opts{$driver . "outputdir"} = $opts{'outputdir'}; } else { - $opts{$driver . "outputdir"} = "$TEXMFVAR/fonts/map/$driver/updmap"; + $opts{$driver . "outputdir"} = "$texmfvar/fonts/map/$driver/updmap"; } } my $od = $opts{$driver . "outputdir"}; @@ -2085,6 +2099,7 @@ Options: --force recreate files even if config hasn't changed --nomkmap do not recreate map files --nohash do not run texhash + --sys run in system wide mode (equivalent to updmap-sys) -n, --dry-run only show the configuration, no output --quiet, --silent reduce verbosity diff --git a/Master/texmf-dist/doc/man/man1/afm2afm.1 b/Master/texmf-dist/doc/man/man1/afm2afm.1 index 3f66df9a8bb..c434e40beb3 100644 --- a/Master/texmf-dist/doc/man/man1/afm2afm.1 +++ b/Master/texmf-dist/doc/man/man1/afm2afm.1 @@ -124,7 +124,7 @@ .\" ======================================================================== .\" .IX Title "AFM2AFM 1" -.TH AFM2AFM 1 "2012-03-06" "fontools" "Marc Penninga" +.TH AFM2AFM 1 "2013-08-07" "fontools" "Marc Penninga" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l @@ -137,6 +137,7 @@ afm2afm \- reencode an afm file .IX Item "afm2afm" [\fB\-help\fR] [\fB\-encoding\fR \fIencodingfile\fR] +[\fB\-kpx\fR \fIkpxfile\fR] [\fB\-output\fR \fIoutputfile\fR] \&\fBafmfile\fR .SH "DESCRIPTION" @@ -145,10 +146,12 @@ afm2afm \- reencode an afm file .PP 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. .PP -Note that if you don't specify an encoding file, the \fIafm\fR 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 \fIafm\fR file isn't re-encoded; +however, all unused (unencoded) data is still pruned. .PP The program also generates an entry for a \fIdvips\fR\-style map file, but only if the \fIafm\fR file has been re-encoded and @@ -162,6 +165,20 @@ Print a short description of the syntax .IP "\fB\-encoding\fR \fIencodingfile\fR" 4 .IX Item "-encoding encodingfile" Re-encode to the enconding in \fIencodingfile\fR +.IP "\fB\-kpx\fR \fIkpxfile\fR" 4 +.IX Item "-kpx kpxfile" +Read additional kerning pairs from \fIkpxfile\fR and add these to the output. +This option cannot be used to override values from the input \fIafm\fR file, +since \fBafm2afm\fR will write both old and new values to the output! +.Sp +The \fIkpxfile\fR should contain kerning data in standard \fIafm\fR format, +i.e. for each kerning pair there should be a line +.Sp +.Vb 1 +\& KPX +.Ve +.Sp +All other lines in the \fIkpxfile\fR are ignored. .IP "\fB\-output\fR \fIoutputfile\fR" 4 .IX Item "-output outputfile" Write the result to \fIoutputfile\fR instead of \f(CW\*(C`stdout\*(C'\fR. @@ -169,20 +186,21 @@ Write the result to \fIoutputfile\fR instead of \f(CW\*(C`stdout\*(C'\fR. .IX Item "afmfile" The \fIafm\fR file to be re-encoded. .PP -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. .SH "AUTHOR" .IX Header "AUTHOR" Marc Penninga .SH "COPYRIGHT" .IX Header "COPYRIGHT" -Copyright (C) 2005\-2012 Marc Penninga. +Copyright (C) 2005\-2013 Marc Penninga. .SH "LICENSE" .IX Header "LICENSE" This program is free software; you can redistribute it and/or modify it under the terms of the \s-1GNU\s0 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 \s-1GNU\s0 General Public License is included with \fBautoinst\fR; +A copy of the \s-1GNU\s0 General Public License is included with \fBafm2afm\fR; see the file \fIGPLv2.txt\fR. .SH "DISCLAIMER" .IX Header "DISCLAIMER" @@ -193,6 +211,11 @@ See the \s-1GNU\s0 General Public License for more details. .SH "RECENT CHANGES" .IX Header "RECENT CHANGES" (See the source code for the rest of the story.) +.IP "\fI2013\-08\-07\fR" 12 +.IX Item "2013-08-07" +Added the \fI\-kpx\fR command-line option. +Replaced all \f(CW\*(C`given/when\*(C'\fR constructions in the source code by \f(CW\*(C`if\*(C'\fR's, +to avoid warnings about experimental features in Perl 5.18 and later. .IP "\fI2012\-02\-01\fR" 12 .IX Item "2012-02-01" Refactored the code; added the \*(L"no re-encoding, only pruning\*(R" diff --git a/Master/texmf-dist/doc/man/man1/afm2afm.man1.pdf b/Master/texmf-dist/doc/man/man1/afm2afm.man1.pdf index 0f87038f515..8c8501ab793 100644 Binary files a/Master/texmf-dist/doc/man/man1/afm2afm.man1.pdf and b/Master/texmf-dist/doc/man/man1/afm2afm.man1.pdf differ diff --git a/Master/texmf-dist/doc/man/man1/autoinst.man1.pdf b/Master/texmf-dist/doc/man/man1/autoinst.man1.pdf index 989320d17d8..bb1d6d508d1 100644 Binary files a/Master/texmf-dist/doc/man/man1/autoinst.man1.pdf and b/Master/texmf-dist/doc/man/man1/autoinst.man1.pdf differ diff --git a/Master/texmf-dist/doc/man/man1/ot2kpx.1 b/Master/texmf-dist/doc/man/man1/ot2kpx.1 index 853982cfffb..f7a598a6b09 100644 --- a/Master/texmf-dist/doc/man/man1/ot2kpx.1 +++ b/Master/texmf-dist/doc/man/man1/ot2kpx.1 @@ -124,7 +124,7 @@ .\" ======================================================================== .\" .IX Title "OT2KPX 1" -.TH OT2KPX 1 "2012-03-06" "fontools" "Marc Penninga" +.TH OT2KPX 1 "2013-08-07" "fontools" "Marc Penninga" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l @@ -155,12 +155,12 @@ multiple fonts, LookupTables with LookupTypes other than 2, \&\*(L"kern\*(R" tables with format other than 0 and ValueRecords with other types of data than just XAdvance data. .Sp -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) \fI\*(L"define subtle, device-dependent -adjustments at specific font sizes or device resolutions\*(R"\fR. -Since there's no way to express such adjustments in \fIafm\fR format, +that come with Adobe Reader). Furthermore, many of these features define +(according to the OpenType specification) \fI\*(L"subtle, device-dependent +adjustments at specific font sizes or device resolutions\*(R"\fR; +since there's no way to express such adjustments in \fIafm\fR format, ignoring them seems to be the only option anyway. .IP "\fB\-\fR" 4 .IX Item "-" @@ -189,14 +189,14 @@ wouldn't make any difference (apart from further complicating the code). Marc Penninga .SH "COPYRIGHT" .IX Header "COPYRIGHT" -Copyright (C) 2005\-2012 Marc Penninga. +Copyright (C) 2005\-2013 Marc Penninga. .SH "LICENSE" .IX Header "LICENSE" This program is free software; you can redistribute it and/or modify it under the terms of the \s-1GNU\s0 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 \s-1GNU\s0 General Public License is included with \fBautoinst\fR; +A copy of the \s-1GNU\s0 General Public License is included with \fBot2kpx\fR; see the file \fIGPLv2.txt\fR. .SH "DISCLAIMER" .IX Header "DISCLAIMER" @@ -207,6 +207,10 @@ See the \s-1GNU\s0 General Public License for more details. .SH "RECENT CHANGES" .IX Header "RECENT CHANGES" (See the source code for the rest of the story.) +.IP "\fI2013\-08\-07\fR" 12 +.IX Item "2013-08-07" +Replaced all \f(CW\*(C`given/when\*(C'\fR constructions in the source code by \f(CW\*(C`if\*(C'\fR's, +to avoid warnings about experimental features in Perl 5.18 and later. .IP "\fI2012\-02\-01\fR" 12 .IX Item "2012-02-01" Refactored the code, and fixed a number of bugs in the process. diff --git a/Master/texmf-dist/doc/man/man1/ot2kpx.man1.pdf b/Master/texmf-dist/doc/man/man1/ot2kpx.man1.pdf index 9d5ddb95a7c..921f9cec8d3 100644 Binary files a/Master/texmf-dist/doc/man/man1/ot2kpx.man1.pdf and b/Master/texmf-dist/doc/man/man1/ot2kpx.man1.pdf differ diff --git a/Master/texmf-dist/doc/support/fontools/README b/Master/texmf-dist/doc/support/fontools/README index f22d4900896..1c83931f109 100644 --- a/Master/texmf-dist/doc/support/fontools/README +++ b/Master/texmf-dist/doc/support/fontools/README @@ -65,4 +65,4 @@ the terms of the GNU General Public Licence. See the file GPLv2.txt for the license conditions. - Marc Penninga, 2013/07/25 + Marc Penninga, 2013/08/07 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