diff options
author | Karl Berry <karl@freefriends.org> | 2013-08-07 23:16:42 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2013-08-07 23:16:42 +0000 |
commit | dc5e48b09a868b75a4eb7b33c6563434818be35b (patch) | |
tree | 98ece6f7d54e4d54372c81bb17f081748bd6a695 /Master/texmf-dist/scripts/fontools/ot2kpx | |
parent | f08589b3e35bcf3f75b93226b3f914b76b76afe9 (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/ot2kpx')
-rwxr-xr-x | Master/texmf-dist/scripts/fontools/ot2kpx | 258 |
1 files changed, 129 insertions, 129 deletions
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. |