1346 lines
44 KiB
Perl
1346 lines
44 KiB
Perl
package Font::TTF::Ttopen;
|
|
|
|
=head1 NAME
|
|
|
|
Font::TTF::Ttopen - Opentype superclass for standard Opentype lookup based tables
|
|
(GSUB and GPOS)
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Handles all the script, lang, feature, lookup stuff for a
|
|
L<Font::TTF::Gsub>/L<Font::TTF::Gpos> table leaving the class specifics to the
|
|
subclass
|
|
|
|
=head1 INSTANCE VARIABLES
|
|
|
|
The instance variables of an opentype table form a complex sub-module hierarchy.
|
|
|
|
=over 4
|
|
|
|
=item Version
|
|
|
|
This contains the version of the table as a floating point number
|
|
|
|
=item SCRIPTS
|
|
|
|
The scripts list is a hash of script tags. Each script tag (of the form
|
|
$t->{'SCRIPTS'}{$tag}) has information below it.
|
|
|
|
=over 8
|
|
|
|
=item OFFSET
|
|
|
|
This variable is preceded by a space and gives the offset from the start of the
|
|
table (not the table section) to the script table for this script
|
|
|
|
=item REFTAG
|
|
|
|
This variable is preceded by a space and gives a corresponding script tag to this
|
|
one such that the offsets in the file are the same. When writing, it is up to the
|
|
caller to ensure that the REFTAGs are set correctly, since these will be used to
|
|
assume that the scripts are identical. Note that REFTAG must refer to a script which
|
|
has no REFTAG of its own.
|
|
|
|
=item DEFAULT
|
|
|
|
This corresponds to the default language for this script, if there is one, and
|
|
contains the same information as an itemised language
|
|
|
|
=item LANG_TAGS
|
|
|
|
This contains an array of language tag strings (each 4 bytes) corresponding to
|
|
the languages listed by this script
|
|
|
|
=item $lang
|
|
|
|
Each language is a hash containing its information:
|
|
|
|
=over 12
|
|
|
|
=item OFFSET
|
|
|
|
This variable is preceded by a a space and gives the offset from the start of
|
|
the whole table to the language table for this language
|
|
|
|
=item REFTAG
|
|
|
|
This variable is preceded by a space and has the same function as for the script
|
|
REFTAG, only for the languages within a script.
|
|
|
|
=item RE-ORDER
|
|
|
|
This indicates re-ordering information, and has not been set. The value should
|
|
always be 0.
|
|
|
|
=item DEFAULT
|
|
|
|
This holds the index of the default feature, if there is one, or -1 otherwise.
|
|
|
|
=item FEATURES
|
|
|
|
This is an array of feature tags for all the features enabled for this language
|
|
|
|
=back
|
|
|
|
=back
|
|
|
|
=item FEATURES
|
|
|
|
The features section of instance variables corresponds to the feature table in
|
|
the opentype table.
|
|
|
|
=over 8
|
|
|
|
=item FEAT_TAGS
|
|
|
|
This array gives the ordered list of feature tags for this table. It is used during
|
|
reading and writing for converting between feature index and feature tag.
|
|
|
|
=back
|
|
|
|
The rest of the FEATURES variable is itself a hash based on the feature tag for
|
|
each feature. Each feature has the following structure:
|
|
|
|
=over 8
|
|
|
|
=item OFFSET
|
|
|
|
This attribute is preceded by a space and gives the offset relative to the start of the whole
|
|
table of this particular feature.
|
|
|
|
=item PARMS
|
|
|
|
If FeatureParams are defined for this feature, this contains a reference to the corresponding FeatureParams object. Otherwise set to null.
|
|
|
|
=item LOOKUPS
|
|
|
|
This is an array containing indices to lookups in the LOOKUP instance variable of the table
|
|
|
|
=item INDEX
|
|
|
|
This gives the feature index for this feature and is used during reading and writing for
|
|
converting between feature tag and feature index.
|
|
|
|
=back
|
|
|
|
=item LOOKUP
|
|
|
|
This variable is an array of lookups in order and is indexed via the features of a language of a
|
|
script. Each lookup contains subtables and other information:
|
|
|
|
=over 8
|
|
|
|
=item OFFSET
|
|
|
|
This name is preceded by a space and contains the offset from the start of the table to this
|
|
particular lookup
|
|
|
|
=item TYPE
|
|
|
|
This is a subclass specific type for a lookup. It stipulates the type of lookup and hence subtables
|
|
within the lookup
|
|
|
|
=item FLAG
|
|
|
|
Holds the lookup flag bits
|
|
|
|
=item FILTER
|
|
|
|
Holds the MarkFilteringSet (that is, the index into GDEF->MARKSETS) for the lookup.
|
|
|
|
=item SUB
|
|
|
|
This holds an array of subtables which are subclass specific. Each subtable must have
|
|
an OFFSET. The other variables described here are an abstraction used in both the
|
|
GSUB and GPOS tables which are the target subclasses of this class.
|
|
|
|
=over 12
|
|
|
|
=item OFFSET
|
|
|
|
This is preceded by a space and gives the offset relative to the start of the table for this
|
|
subtable
|
|
|
|
=item FORMAT
|
|
|
|
Gives the sub-table sub format for this GSUB subtable. It is assumed that this
|
|
value is correct when it comes time to write the subtable.
|
|
|
|
=item COVERAGE
|
|
|
|
Most lookups consist of a coverage table corresponding to the first
|
|
glyph to match. The offset of this coverage table is stored here and the coverage
|
|
table looked up against the GSUB table proper. There are two lookups
|
|
without this initial coverage table which is used to index into the RULES array.
|
|
These lookups have one element in the RULES array which is used for the whole
|
|
match.
|
|
|
|
=item RULES
|
|
|
|
The rules are a complex array. In most cases, each element of the array
|
|
corresponds to an element in the coverage table (governed by the coverage index).
|
|
In a few caess, such as when there is
|
|
no coverage table, then there is considered to be only one element in the rules
|
|
array. Each element of the array is itself an array corresponding to the
|
|
possibly multiple string matches which may follow the initial glyph. Each
|
|
element of this array is a hash with fixed keys corresponding to information
|
|
needed to match a glyph string or act upon it. Thus the RULES element is an
|
|
array of arrays of hashes which contain the following keys:
|
|
|
|
=over 16
|
|
|
|
=item MATCH
|
|
|
|
This contains a sequence of elements held as an array. The elements may be
|
|
glyph ids (gid), class ids (cids), or offsets to coverage tables. Each element
|
|
corresponds to one glyph in the glyph string. See MATCH_TYPE for details of
|
|
how the different element types are marked.
|
|
|
|
=item PRE
|
|
|
|
This array holds the sequence of elements preceding the first match element
|
|
and has the same form as the MATCH array.
|
|
|
|
=item POST
|
|
|
|
This array holds the sequence of elements to be tested for following the match
|
|
string and is of the same form as the MATCH array.
|
|
|
|
=item ACTION
|
|
|
|
This array holds information regarding what should be done if a match is found.
|
|
The array may either hold glyph ids (which are used to replace or insert or
|
|
whatever glyphs in the glyph string) or 2 element arrays consisting of:
|
|
|
|
=over 20
|
|
|
|
=item OFFSET
|
|
|
|
Offset from the start of the matched string that the lookup should start at
|
|
when processing the substring.
|
|
|
|
=item LOOKUP_INDEX
|
|
|
|
The index to a lookup to be acted upon on the match string.
|
|
|
|
=back
|
|
|
|
=back
|
|
|
|
=item CLASS
|
|
|
|
For those lookups which use class categories rather than glyph ids for matching
|
|
this is the offset to the class definition used to categories glyphs in the
|
|
match string.
|
|
|
|
=item PRE_CLASS
|
|
|
|
This is the offset to the class definition for the before match glyphs
|
|
|
|
=item POST_CLASS
|
|
|
|
This is the offset to the class definition for the after match glyphs.
|
|
|
|
=item ACTION_TYPE
|
|
|
|
This string holds the type of information held in the ACTION variable of a RULE.
|
|
It is subclass specific.
|
|
|
|
=item MATCH_TYPE
|
|
|
|
This holds the type of information in the MATCH array of a RULE. This is subclass
|
|
specific.
|
|
|
|
=item ADJUST
|
|
|
|
This corresponds to a single action for all items in a coverage table. The meaning
|
|
is subclass specific.
|
|
|
|
=item CACHE
|
|
|
|
This key starts with a space
|
|
|
|
A hash of other tables (such as coverage tables, classes, anchors, device tables)
|
|
based on the offset given in the subtable to that other information.
|
|
Note that the documentation is particularly
|
|
unhelpful here in that such tables are given as offsets relative to the
|
|
beginning of the subtable not the whole GSUB table. This includes those items which
|
|
are stored relative to another base within the subtable.
|
|
|
|
=back
|
|
|
|
=back
|
|
|
|
=back
|
|
|
|
=head1 METHODS
|
|
|
|
=cut
|
|
|
|
use Font::TTF::Table;
|
|
use Font::TTF::Utils;
|
|
use Font::TTF::Coverage;
|
|
|
|
use strict;
|
|
use vars qw(@ISA %FeatParams);
|
|
|
|
@ISA = qw(Font::TTF::Table);
|
|
|
|
%FeatParams = (
|
|
'ss' => 'Font::TTF::Features::Sset',
|
|
'cv' => 'Font::TTF::Features::Cvar',
|
|
'si' => 'Font::TTF::Features::Size',
|
|
);
|
|
|
|
=head2 $t->read
|
|
|
|
Reads the table passing control to the subclass to handle the subtable specifics
|
|
|
|
=cut
|
|
|
|
sub read
|
|
{
|
|
my ($self) = @_;
|
|
$self->SUPER::read or return $self;
|
|
|
|
my ($dat, $i, $l, $oScript, $oFeat, $oLook, $tag, $nScript, $off, $dLang, $nLang, $lTag);
|
|
my ($nFeat, $oParms, $FType, $nLook, $nSub, $j, $temp, $t);
|
|
my ($fh) = $self->{' INFILE'};
|
|
my ($moff) = $self->{' OFFSET'};
|
|
|
|
$fh->read($dat, 10);
|
|
($self->{'Version'}, $oScript, $oFeat, $oLook) = TTF_Unpack("vSSS", $dat);
|
|
|
|
# read features first so that in the script/lang hierarchy we can use feature tags
|
|
|
|
$fh->seek($moff + $oFeat, 0);
|
|
$fh->read($dat, 2);
|
|
$nFeat = unpack("n", $dat);
|
|
$self->{'FEATURES'} = {};
|
|
$l = $self->{'FEATURES'};
|
|
$fh->read($dat, 6 * $nFeat);
|
|
for ($i = 0; $i < $nFeat; $i++)
|
|
{
|
|
($tag, $off) = unpack("a4n", substr($dat, $i * 6, 6));
|
|
while (defined $l->{$tag})
|
|
{
|
|
if ($tag =~ m/(.*?)\s_(\d+)$/o)
|
|
{ $tag = $1 . " _" . ($2 + 1); }
|
|
else
|
|
{ $tag .= " _0"; }
|
|
}
|
|
$l->{$tag}{' OFFSET'} = $off + $oFeat;
|
|
$l->{$tag}{'INDEX'} = $i;
|
|
push (@{$l->{'FEAT_TAGS'}}, $tag);
|
|
}
|
|
|
|
foreach $tag (grep {m/^.{4}(?:\s_\d+)?$/o} keys %$l)
|
|
{
|
|
$oFeat=$moff + $l->{$tag}{' OFFSET'};
|
|
$fh->seek($oFeat, 0);
|
|
$fh->read($dat, 4);
|
|
($oParms, $nLook) = unpack("n2", $dat);
|
|
$fh->read($dat, $nLook * 2);
|
|
$l->{$tag}{'LOOKUPS'} = [unpack("n*", $dat)];
|
|
$l->{$tag}{'PARMS'}="";
|
|
if ($oParms > 0)
|
|
{
|
|
$FType=$FeatParams{substr($tag,0,2)};
|
|
if ($FType)
|
|
{
|
|
$t=$FType;
|
|
if ($^O eq "MacOS")
|
|
{ $t =~ s/^|::/:/oig; }
|
|
else
|
|
{ $t =~ s|::|/|oig; }
|
|
require "$t.pm";
|
|
$l->{$tag}{'PARMS'} = $FType->new( INFILE => $fh,
|
|
OFFSET => $oFeat+$oParms);
|
|
$l->{$tag}{'PARMS'}->read;
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
# Now the script/lang hierarchy
|
|
|
|
$fh->seek($moff + $oScript, 0);
|
|
$fh->read($dat, 2);
|
|
$nScript = unpack("n", $dat);
|
|
$self->{'SCRIPTS'} = {};
|
|
$l = $self->{'SCRIPTS'};
|
|
$fh->read($dat, 6 * $nScript);
|
|
for ($i = 0; $i < $nScript; $i++)
|
|
{
|
|
($tag, $off) = unpack("a4n", substr($dat, $i * 6, 6));
|
|
$off += $oScript;
|
|
foreach (keys %$l)
|
|
{ $l->{$tag}{' REFTAG'} = $_ if ($l->{$_}{' OFFSET'} == $off
|
|
&& !defined $l->{$_}{' REFTAG'}); }
|
|
$l->{$tag}{' OFFSET'} = $off;
|
|
}
|
|
|
|
foreach $tag (keys %$l)
|
|
{
|
|
next if ($l->{$tag}{' REFTAG'});
|
|
$fh->seek($moff + $l->{$tag}{' OFFSET'}, 0);
|
|
$fh->read($dat, 4);
|
|
($dLang, $nLang) = unpack("n2", $dat);
|
|
$l->{$tag}{'DEFAULT'}{' OFFSET'} =
|
|
$dLang + $l->{$tag}{' OFFSET'} if $dLang;
|
|
$fh->read($dat, 6 * $nLang);
|
|
for ($i = 0; $i < $nLang; $i++)
|
|
{
|
|
($lTag, $off) = unpack("a4n", substr($dat, $i * 6, 6));
|
|
$off += $l->{$tag}{' OFFSET'};
|
|
$l->{$tag}{$lTag}{' OFFSET'} = $off;
|
|
foreach (@{$l->{$tag}{'LANG_TAGS'}}, 'DEFAULT')
|
|
{ $l->{$tag}{$lTag}{' REFTAG'} = $_ if ($l->{$tag}{$_}{' OFFSET'} == $off
|
|
&& !$l->{$tag}{$_}{' REFTAG'}); }
|
|
push (@{$l->{$tag}{'LANG_TAGS'}}, $lTag);
|
|
}
|
|
foreach $lTag (@{$l->{$tag}{'LANG_TAGS'}}, 'DEFAULT')
|
|
{
|
|
next unless defined $l->{$tag}{$lTag};
|
|
next if ($l->{$tag}{$lTag}{' REFTAG'});
|
|
$fh->seek($moff + $l->{$tag}{$lTag}{' OFFSET'}, 0);
|
|
$fh->read($dat, 6);
|
|
($l->{$tag}{$lTag}{'RE-ORDER'}, $l->{$tag}{$lTag}{'DEFAULT'}, $nFeat)
|
|
= unpack("n3", $dat);
|
|
$fh->read($dat, $nFeat * 2);
|
|
$l->{$tag}{$lTag}{'FEATURES'} = [map {$self->{'FEATURES'}{'FEAT_TAGS'}[$_]} unpack("n*", $dat)];
|
|
}
|
|
foreach $lTag (@{$l->{$tag}{'LANG_TAGS'}}, 'DEFAULT')
|
|
{
|
|
# Make copies of referenced languages for each reference.
|
|
next unless $l->{$tag}{$lTag}{' REFTAG'};
|
|
$temp = $l->{$tag}{$lTag}{' REFTAG'};
|
|
$l->{$tag}{$lTag} = ©($l->{$tag}{$temp});
|
|
$l->{$tag}{$lTag}{' REFTAG'} = $temp;
|
|
}
|
|
}
|
|
foreach $tag (keys %$l)
|
|
{
|
|
next unless $l->{$tag}{' REFTAG'};
|
|
$temp = $l->{$tag}{' REFTAG'};
|
|
$l->{$tag} = ©($l->{$temp});
|
|
$l->{$tag}{' REFTAG'} = $temp;
|
|
}
|
|
|
|
# And finally the lookups
|
|
|
|
$fh->seek($moff + $oLook, 0);
|
|
$fh->read($dat, 2);
|
|
$nLook = unpack("n", $dat);
|
|
$fh->read($dat, $nLook * 2);
|
|
$i = 0;
|
|
map { $self->{'LOOKUP'}[$i++]{' OFFSET'} = $_; } unpack("n*", $dat);
|
|
|
|
for ($i = 0; $i < $nLook; $i++)
|
|
{
|
|
$l = $self->{'LOOKUP'}[$i];
|
|
$fh->seek($l->{' OFFSET'} + $moff + $oLook, 0);
|
|
$fh->read($dat, 6);
|
|
($l->{'TYPE'}, $l->{'FLAG'}, $nSub) = unpack("n3", $dat);
|
|
$fh->read($dat, $nSub * 2);
|
|
my @offsets = unpack("n*", $dat);
|
|
if ($l->{'FLAG'} & 0x0010)
|
|
{
|
|
$fh->read($dat, 2);
|
|
$l->{'FILTER'} = unpack("n", $dat);
|
|
}
|
|
my $isExtension = ($l->{'TYPE'} == $self->extension());
|
|
for ($j = 0; $j < $nSub; $j++)
|
|
{
|
|
$l->{'SUB'}[$j]{' OFFSET'} = $offsets[$j];
|
|
$fh->seek($moff + $oLook + $l->{' OFFSET'} + $l->{'SUB'}[$j]{' OFFSET'}, 0);
|
|
if ($isExtension)
|
|
{
|
|
$fh->read($dat, 8);
|
|
my $longOff;
|
|
(undef, $l->{'TYPE'}, $longOff) = unpack("nnN", $dat);
|
|
$l->{'SUB'}[$j]{' OFFSET'} += $longOff;
|
|
$fh->seek($moff + $oLook + $l->{' OFFSET'} + $l->{'SUB'}[$j]{' OFFSET'}, 0);
|
|
}
|
|
$self->read_sub($fh, $l, $j);
|
|
}
|
|
}
|
|
return $self;
|
|
}
|
|
|
|
=head2 $t->read_sub($fh, $lookup, $index)
|
|
|
|
This stub is to allow subclasses to read subtables of lookups in a table specific manner. A
|
|
reference to the lookup is passed in along with the subtable index. The file is located at the
|
|
start of the subtable to be read
|
|
|
|
=cut
|
|
|
|
sub read_sub
|
|
{ }
|
|
|
|
|
|
=head2 $t->extension()
|
|
|
|
Returns the lookup number for the extension table that allows access to 32-bit offsets.
|
|
|
|
=cut
|
|
|
|
sub extension
|
|
{ }
|
|
|
|
|
|
=head2 $t->out($fh)
|
|
|
|
Writes this Opentype table to the output calling $t->out_sub for each sub table
|
|
at the appropriate point in the output. The assumption is that on entry the
|
|
number of scripts, languages, features, lookups, etc. are all resolved and
|
|
the relationships fixed. This includes a LANG_TAGS list for a script, and that all
|
|
scripts and languages in their respective dictionaries either have a REFTAG or contain
|
|
real data.
|
|
|
|
=cut
|
|
|
|
sub out
|
|
{
|
|
my ($self, $fh) = @_;
|
|
my ($i, $j, $base, $off, $tag, $t, $l, $lTag, $oScript, @script, @tags);
|
|
my ($end, $nTags, @offs, $oFeat, $oFtable, $oParms, $FType, $oLook, $nSub, $nSubs, $big, $out);
|
|
|
|
return $self->SUPER::out($fh) unless $self->{' read'};
|
|
|
|
# First sort the features
|
|
$i = 0;
|
|
$self->{'FEATURES'}{'FEAT_TAGS'} = [sort grep {m/^.{4}(?:\s_\d+)?$/o} %{$self->{'FEATURES'}}]
|
|
if (!defined $self->{'FEATURES'}{'FEAT_TAGS'});
|
|
foreach $t (@{$self->{'FEATURES'}{'FEAT_TAGS'}})
|
|
{ $self->{'FEATURES'}{$t}{'INDEX'} = $i++; }
|
|
|
|
$base = $fh->tell();
|
|
$fh->print(TTF_Pack("v", $self->{'Version'}));
|
|
$fh->print(pack("n3", 10, 0, 0));
|
|
$oScript = $fh->tell() - $base;
|
|
@script = sort grep {length($_) == 4} keys %{$self->{'SCRIPTS'}};
|
|
$fh->print(pack("n", $#script + 1));
|
|
foreach $t (@script)
|
|
{ $fh->print(pack("a4n", $t, 0)); }
|
|
|
|
$end = $fh->tell();
|
|
foreach $t (@script)
|
|
{
|
|
$fh->seek($end, 0);
|
|
$tag = $self->{'SCRIPTS'}{$t};
|
|
next if ($tag->{' REFTAG'});
|
|
$tag->{' OFFSET'} = tell($fh) - $base - $oScript;
|
|
$fh->print(pack("n2", 0, $#{$tag->{'LANG_TAGS'}} + 1));
|
|
foreach $lTag (sort @{$tag->{'LANG_TAGS'}})
|
|
{ $fh->print(pack("a4n", $lTag, 0)); }
|
|
foreach $lTag (@{$tag->{'LANG_TAGS'}}, 'DEFAULT')
|
|
{
|
|
my ($def);
|
|
$l = $tag->{$lTag};
|
|
next if (!defined $l || (defined $l->{' REFTAG'} && $l->{' REFTAG'} ne ''));
|
|
$l->{' OFFSET'} = $fh->tell() - $base - $oScript - $tag->{' OFFSET'};
|
|
if (defined $l->{'DEFAULT'})
|
|
# { $def = $self->{'FEATURES'}{$l->{'FEATURES'}[$l->{'DEFAULT'}]}{'INDEX'}; }
|
|
{ $def = $l->{'DEFAULT'}; }
|
|
else
|
|
{ $def = -1; }
|
|
$fh->print(pack("n*", $l->{'RE_ORDER'} || 0, $def, $#{$l->{'FEATURES'}} + 1,
|
|
map {$self->{'FEATURES'}{$_}{'INDEX'} || 0} @{$l->{'FEATURES'}}));
|
|
}
|
|
$end = $fh->tell();
|
|
if ($tag->{'DEFAULT'}{' REFTAG'} || defined $tag->{'DEFAULT'}{'FEATURES'})
|
|
{
|
|
$fh->seek($base + $oScript + $tag->{' OFFSET'}, 0);
|
|
if (defined $tag->{'DEFAULT'}{' REFTAG'})
|
|
{
|
|
my ($ttag);
|
|
for ($ttag = $tag->{'DEFAULT'}{' REFTAG'}; defined $tag->{$ttag}{' REFTAG'}; $ttag = $tag->{$ttag}{' REFTAG'})
|
|
{ }
|
|
$off = $tag->{$ttag}{' OFFSET'};
|
|
}
|
|
else
|
|
{ $off = $tag->{'DEFAULT'}{' OFFSET'}; }
|
|
$fh->print(pack("n", $off));
|
|
}
|
|
$fh->seek($base + $oScript + $tag->{' OFFSET'} + 4, 0);
|
|
foreach (sort @{$tag->{'LANG_TAGS'}})
|
|
{
|
|
if (defined $tag->{$_}{' REFTAG'})
|
|
{
|
|
my ($ttag);
|
|
for ($ttag = $tag->{$_}{' REFTAG'}; defined $tag->{$ttag}{' REFTAG'}; $ttag = $tag->{$ttag}{' REFTAG'})
|
|
{ }
|
|
$off = $tag->{$ttag}{' OFFSET'};
|
|
}
|
|
else
|
|
{ $off = $tag->{$_}{' OFFSET'}; }
|
|
$fh->print(pack("a4n", $_, $off));
|
|
}
|
|
}
|
|
$fh->seek($base + $oScript + 2, 0);
|
|
foreach $t (@script)
|
|
{
|
|
$tag = $self->{'SCRIPTS'}{$t};
|
|
$off = $tag->{' REFTAG'} ? $tag->{$tag->{' REFTAG'}}{' OFFSET'} : $tag->{' OFFSET'};
|
|
$fh->print(pack("a4n", $t, $off));
|
|
}
|
|
|
|
$fh->seek($end, 0);
|
|
$oFeat = $end - $base;
|
|
$nTags = $#{$self->{'FEATURES'}{'FEAT_TAGS'}} + 1;
|
|
$fh->print(pack("n", $nTags));
|
|
$fh->print(pack("a4n", " ", 0) x $nTags);
|
|
|
|
foreach $t (@{$self->{'FEATURES'}{'FEAT_TAGS'}})
|
|
{
|
|
$tag = $self->{'FEATURES'}{$t};
|
|
$oFtable = tell($fh) - $base - $oFeat;
|
|
$tag->{' OFFSET'} = $oFtable;
|
|
$fh->print(pack("n*", 0, $#{$tag->{'LOOKUPS'}} + 1, @{$tag->{'LOOKUPS'}}));
|
|
if ($tag->{'PARMS'})
|
|
{
|
|
$end = $fh->tell();
|
|
$oParms = $end - $oFtable - $base - $oFeat;
|
|
$fh->seek($oFtable + $base + $oFeat,0);
|
|
$fh->print(pack("n",$oParms));
|
|
$fh->seek($end,0);
|
|
$tag->{'PARMS'}->out($fh);
|
|
}
|
|
}
|
|
$end = $fh->tell();
|
|
$fh->seek($oFeat + $base + 2, 0);
|
|
foreach $t (@{$self->{'FEATURES'}{'FEAT_TAGS'}})
|
|
{ $fh->print(pack("a4n", $t, $self->{'FEATURES'}{$t}{' OFFSET'})); }
|
|
|
|
undef $big;
|
|
$fh->seek($end, 0);
|
|
$oLook = $end - $base;
|
|
|
|
# LookupListTable (including room for offsets to LookupTables)
|
|
$nTags = $#{$self->{'LOOKUP'}} + 1;
|
|
$fh->print(pack("n", $nTags));
|
|
$fh->print(pack("n", 0) x $nTags);
|
|
$end = $fh->tell(); # end of LookupListTable = start of Lookups
|
|
foreach $tag (@{$self->{'LOOKUP'}})
|
|
{ $nSubs += $self->num_sub($tag); }
|
|
for ($i = 0; $i < $nTags; $i++)
|
|
{
|
|
$fh->seek($end, 0);
|
|
$tag = $self->{'LOOKUP'}[$i];
|
|
$off = $end - $base - $oLook; # BH 2004-03-04
|
|
# Is there room, from the start of this i'th lookup, for this and the remaining
|
|
# lookups to be wrapped in extension lookups?
|
|
if (!defined $big && $off + ($nTags - $i) * 6 + $nSubs * 10 > 65535) # BH 2004-03-04
|
|
{
|
|
# Not enough room -- need to start an extension!
|
|
my ($k, $ext);
|
|
$ext = $self->extension();
|
|
# Must turn previous lookup into the first extension
|
|
$i--;
|
|
$tag = $self->{'LOOKUP'}[$i];
|
|
$end = $tag->{' OFFSET'} + $base + $oLook;
|
|
$fh->seek($end, 0);
|
|
$big = $i;
|
|
# For this and the remaining lookups, build extensions lookups
|
|
for ($j = $i; $j < $nTags; $j++)
|
|
{
|
|
$tag = $self->{'LOOKUP'}[$j];
|
|
$nSub = $self->num_sub($tag);
|
|
$tag->{' OFFSET'} = $fh->tell() - $base - $oLook; # offset to this extension lookup
|
|
# LookupTable (including actual offsets to subtables)
|
|
$fh->print(pack("nnn", $ext, $tag->{'FLAG'}, $nSub));
|
|
$fh->print(pack("n*", map {6 + $nSub * 2 + $_ * 8 + ($tag->{'FLAG'} & 0x0010 ? 2 : 0) } (0 .. $nSub-1)));
|
|
$fh->print(pack("n", $tag->{'FILTER'})) if $tag->{'FLAG'} & 0x0010;
|
|
$tag->{' EXT_OFFSET'} = $fh->tell(); # = first extension lookup subtable
|
|
for ($k = 0; $k < $nSub; $k++)
|
|
{ $fh->print(pack('nnN', 1, $tag->{'TYPE'}, 0)); }
|
|
}
|
|
|
|
$tag = $self->{'LOOKUP'}[$i];
|
|
# Leave file positioned after all the extension lookups -- where the referenced lookups will start.
|
|
}
|
|
$tag->{' OFFSET'} = $off unless defined $big; # BH 2004-03-04
|
|
$nSub = $self->num_sub($tag);
|
|
if (!defined $big)
|
|
{
|
|
# LookupTable (including room for subtable offsets)
|
|
$fh->print(pack("nnn", $tag->{'TYPE'}, $tag->{'FLAG'}, $nSub));
|
|
$fh->print(pack("n", 0) x $nSub);
|
|
$fh->print(pack("n", $tag->{'FILTER'})) if $tag->{'FLAG'} & 0x0010;
|
|
}
|
|
else
|
|
{ $end = $tag->{' EXT_OFFSET'}; } # Extension offsets computed relative to start of first Extension subtable -- corrected later
|
|
my (@offs, $out, @refs);
|
|
for ($j = 0; $j < $nSub; $j++)
|
|
{
|
|
my ($ctables) = {};
|
|
my ($base) = length($out);
|
|
push(@offs, tell($fh) - $end + $base);
|
|
$out .= $self->out_sub($fh, $tag, $j, $ctables, $base);
|
|
push (@refs, [$ctables, $base]);
|
|
}
|
|
out_final($fh, $out, \@refs);
|
|
$end = $fh->tell();
|
|
if (!defined $big)
|
|
{
|
|
$fh->seek($tag->{' OFFSET'} + $base + $oLook + 6, 0);
|
|
$fh->print(pack("n*", @offs));
|
|
}
|
|
else
|
|
{
|
|
$fh->seek($tag->{' EXT_OFFSET'}, 0);
|
|
for ($j = 0; $j < $nSub; $j++)
|
|
{ $fh->print(pack('nnN', 1, $tag->{'TYPE'}, $offs[$j] - $j * 8)); }
|
|
}
|
|
}
|
|
$fh->seek($oLook + $base + 2, 0);
|
|
$fh->print(pack("n*", map {$self->{'LOOKUP'}[$_]{' OFFSET'}} (0 .. $nTags - 1)));
|
|
$fh->seek($base + 6, 0);
|
|
$fh->print(pack('n2', $oFeat, $oLook));
|
|
$fh->seek($end, 0);
|
|
$self;
|
|
}
|
|
|
|
|
|
=head2 $t->num_sub($lookup)
|
|
|
|
Asks the subclass to count the number of subtables for a particular lookup and to
|
|
return that value. Used in out().
|
|
|
|
=cut
|
|
|
|
sub num_sub
|
|
{
|
|
my ($self, $lookup) = @_;
|
|
|
|
return $#{$lookup->{'SUB'}} + 1;
|
|
}
|
|
|
|
|
|
=head2 $t->out_sub($fh, $lookup, $index)
|
|
|
|
This stub is to allow subclasses to output subtables of lookups in a table specific manner. A
|
|
reference to the lookup is passed in along with the subtable index. The file is located at the
|
|
start of the subtable to be output
|
|
|
|
=cut
|
|
|
|
sub out_sub
|
|
{ }
|
|
|
|
=head2 $t->dirty
|
|
|
|
Setting GPOS or GSUB dirty means that OS/2 may need updating, so set it dirty.
|
|
|
|
=cut
|
|
|
|
sub dirty
|
|
{
|
|
my ($self, $val) = @_;
|
|
my $res = $self->SUPER::dirty ($val);
|
|
$self->{' PARENT'}{'OS/2'}->read->dirty($val) if exists $self->{' PARENT'}{'OS/2'};
|
|
$res;
|
|
}
|
|
|
|
=head2 $t->maxContext
|
|
|
|
Returns the length of the longest opentype rule in this table.
|
|
|
|
=cut
|
|
|
|
sub maxContext
|
|
{
|
|
my ($self) = @_;
|
|
|
|
# Make sure table is read
|
|
$self->read;
|
|
|
|
# Calculate my contribution to OS/2 usMaxContext
|
|
|
|
my ($maxcontext, $l, $s, $r, $m);
|
|
|
|
for $l (@{$self->{'LOOKUP'}}) # Examine each lookup
|
|
{
|
|
for $s (@{$l->{'SUB'}}) # Multiple possible subtables for this lookup
|
|
{
|
|
for $r (@{$s->{'RULES'}}) # One ruleset for each covered glyph
|
|
{
|
|
for $m (@{$r}) # Multiple possible matches for this covered glyph
|
|
{
|
|
my $lgt;
|
|
$lgt++ if exists $s->{'COVERAGE'}; # Count 1 for the coverage table if it exists
|
|
for (qw(MATCH POST)) # only Input and Lookahead sequences count (Lookbehind doesn't) -- see OT spec.
|
|
{
|
|
$lgt += @{$m->{$_}} if exists $m->{$_};
|
|
}
|
|
$maxcontext = $lgt if $lgt > $maxcontext;
|
|
}
|
|
}
|
|
|
|
}
|
|
}
|
|
|
|
$maxcontext;
|
|
}
|
|
|
|
|
|
=head2 $t->update
|
|
|
|
Perform various housekeeping items:
|
|
|
|
For all lookups, set/clear 0x0010 bit of flag words based on 'FILTER' value.
|
|
|
|
Sort COVERAGE table and RULES for all lookups.
|
|
|
|
Unless $t->{' PARENT'}{' noharmony'} is true, update will make sure that GPOS and GSUB include
|
|
the same scripts and languages. Any added scripts and languages will have empty feature sets.
|
|
|
|
=cut
|
|
|
|
# Assumes we are called on both GSUB and GPOS. So simply ADDS scripts and languages to $self that it finds
|
|
# in the other table.
|
|
|
|
sub update
|
|
{
|
|
my ($self) = @_;
|
|
|
|
return undef unless ($self->SUPER::update);
|
|
|
|
if (defined ($self->{'LOOKUP'}))
|
|
{
|
|
|
|
# make flag word agree with mark filter setting:
|
|
for my $l (@{$self->{'LOOKUP'}})
|
|
{
|
|
if (defined $l->{'FILTER'})
|
|
{ $l->{'FLAG'} |= 0x0010; }
|
|
else
|
|
{ $l->{'FLAG'} &= ~0x0010; }
|
|
}
|
|
|
|
unless ($Font::TTF::Coverage::dontsort)
|
|
{
|
|
# Sort coverage tables and rules of all lookups by glyphID
|
|
# The lookup types that need to be sorted are:
|
|
# GSUB: 1.2 2 3 4 5.1 6.1 8 (However GSUB type 8 lookups are not yet supported by Font::TTF)
|
|
# GPOS: 1.2 2.1 3 4 5 6 7.1 8.1
|
|
|
|
for my $l (@{$self->{'LOOKUP'}})
|
|
{
|
|
next unless defined $l->{'SUB'};
|
|
for my $sub (@{$l->{'SUB'}})
|
|
{
|
|
if (defined $sub->{'COVERAGE'} and $sub->{'COVERAGE'}{'cover'} and !$sub->{'COVERAGE'}{'dontsort'})
|
|
{
|
|
# OK! Found a lookup with coverage table:
|
|
my @map = $sub->{'COVERAGE'}->sort();
|
|
if (defined $sub->{'RULES'} and ($sub->{'MATCH_TYPE'} =~ /g/ or $sub->{'ACTION_TYPE'} =~ /[gvea]/))
|
|
{
|
|
# And also a RULES table which now needs to be re-sorted
|
|
my $newrules = [];
|
|
foreach (0 .. $#map)
|
|
{ push @{$newrules}, $sub->{'RULES'}[$map[$_]]; }
|
|
$sub->{'RULES'} = $newrules;
|
|
}
|
|
}
|
|
|
|
# Special case for Mark positioning -- need to also sort the MarkArray
|
|
if (exists($sub->{'MARKS'}) and ref($sub->{'MATCH'}[0]) =~ /Cover/ and $sub->{'MATCH'}[0]{'cover'} and !$sub->{'MATCH'}[0]{'dontsort'})
|
|
{
|
|
my @map = $sub->{'MATCH'}[0]->sort();
|
|
my $newmarks = [];
|
|
foreach (0 .. $#map)
|
|
{ push @{$newmarks}, $sub->{'MARKS'}[$map[$_]]; }
|
|
$sub->{'MARKS'} = $newmarks;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Enforce script/lang congruence unless asked not to:
|
|
return $self if $self->{' PARENT'}{' noharmony'};
|
|
|
|
# Find my sibling (GSUB or GPOS, depending on which I am)
|
|
my $sibling = ref($self) eq 'Font::TTF::GSUB' ? 'GPOS' : ref($self) eq 'Font::TTF::GPOS' ? 'GSUB' : undef;
|
|
return $self unless $sibling && defined $self->{' PARENT'}{$sibling};
|
|
$sibling = $self->{' PARENT'}{$sibling};
|
|
|
|
# Look through scripts defined in sibling:
|
|
for my $sTag (grep {length($_) == 4} keys %{$sibling->{'SCRIPTS'}})
|
|
{
|
|
my $sibScript = $sibling->{'SCRIPTS'}{$sTag};
|
|
$sibScript = $sibling->{$sibScript->{' REFTAG'}} if exists $sibScript->{' REFTAG'} && $sibScript->{' REFTAG'} ne '';
|
|
|
|
$self->{'SCRIPTS'}{$sTag} = {} unless defined $self->{'SCRIPTS'}{$sTag}; # Create script if not present in $self
|
|
|
|
my $myScript = $self->{'SCRIPTS'}{$sTag};
|
|
$myScript = $self->{$myScript->{' REFTAG'}} if exists $myScript->{' REFTAG'} && $myScript->{' REFTAG'} ne '';
|
|
|
|
foreach my $lTag (@{$sibScript->{'LANG_TAGS'}})
|
|
{
|
|
# Ok, found a script/lang that is in our sibling.
|
|
next if exists $myScript->{$lTag}; # Already in $self
|
|
|
|
# Need to create this lang:
|
|
push @{$myScript->{'LANG_TAGS'}}, $lTag;
|
|
$myScript->{$lTag} = { 'FEATURES' => [] };
|
|
}
|
|
|
|
if (defined $sibScript->{'DEFAULT'} && !defined $myScript->{'DEFAULT'})
|
|
{
|
|
# Create default lang for this script.
|
|
$myScript->{'DEFAULT'} = { 'FEATURES' => [] };
|
|
}
|
|
}
|
|
$self;
|
|
}
|
|
|
|
=head1 Internal Functions & Methods
|
|
|
|
Most of these methods are used by subclasses for handling such things as coverage
|
|
tables.
|
|
|
|
=head2 copy($ref)
|
|
|
|
Internal function to copy the top level of a dictionary to create a new dictionary.
|
|
Only the top level is copied.
|
|
|
|
=cut
|
|
|
|
sub copy
|
|
{
|
|
my ($ref) = @_;
|
|
my ($res) = {};
|
|
|
|
foreach (keys %$ref)
|
|
{ $res->{$_} = $ref->{$_}; }
|
|
$res;
|
|
}
|
|
|
|
|
|
=head2 $t->read_cover($cover_offset, $lookup_loc, $lookup, $fh, $is_cover)
|
|
|
|
Reads a coverage table and stores the results in $lookup->{' CACHE'}, that is, if
|
|
it has not been read already.
|
|
|
|
=cut
|
|
|
|
sub read_cover
|
|
{
|
|
my ($self, $offset, $base, $lookup, $fh, $is_cover) = @_;
|
|
my ($loc) = $fh->tell();
|
|
my ($cover, $str);
|
|
|
|
return undef unless $offset;
|
|
$str = sprintf("%X", $base + $offset);
|
|
return $lookup->{' CACHE'}{$str} if defined $lookup->{' CACHE'}{$str};
|
|
$fh->seek($base + $offset, 0);
|
|
$cover = Font::TTF::Coverage->new($is_cover)->read($fh);
|
|
$fh->seek($loc, 0);
|
|
$lookup->{' CACHE'}{$str} = $cover;
|
|
return $cover;
|
|
}
|
|
|
|
|
|
=head2 ref_cache($obj, $cache, $offset [, $template])
|
|
|
|
Internal function to keep track of the local positioning of subobjects such as
|
|
coverage and class definition tables, and their offsets.
|
|
What happens is that the cache is a hash of
|
|
sub objects indexed by the reference (using a string mashing of the
|
|
reference name which is valid for the duration of the reference) and holds a
|
|
list of locations in the output string which should be filled in with the
|
|
offset to the sub object when the final string is output in out_final.
|
|
|
|
Uses tricks for Tie::Refhash
|
|
|
|
=cut
|
|
|
|
sub ref_cache
|
|
{
|
|
my ($obj, $cache, $offset, $template) = @_;
|
|
|
|
return 0 unless defined $obj;
|
|
$template ||= 'n';
|
|
unless (defined $cache->{"$obj"})
|
|
{ push (@{$cache->{''}}, $obj); }
|
|
push (@{$cache->{"$obj"}}, [$offset, $template]);
|
|
return 0;
|
|
}
|
|
|
|
|
|
=head2 out_final($fh, $out, $cache_list, $state)
|
|
|
|
Internal function to actually output everything to the file handle given that
|
|
now we know the offset to the first sub object to be output and which sub objects
|
|
are to be output and what locations need to be updated, we can now
|
|
generate everything. $cache_list is an array of two element arrays. The first element
|
|
is a cache object, the second is an offset to be subtracted from each reference
|
|
to that object made in the cache.
|
|
|
|
If $state is 1, then the output is not sent to the filehandle and the return value
|
|
is the string to be output. If $state is absent or 0 then output is not limited
|
|
by storing in a string first and the return value is "";
|
|
|
|
=cut
|
|
|
|
sub out_final
|
|
{
|
|
my ($fh, $out, $cache_list, $state) = @_;
|
|
my ($len) = length($out || '');
|
|
my ($base_loc) = $state ? 0 : $fh->tell();
|
|
my ($loc, $t, $r, $s, $master_cache, $offs, $str, %vecs);
|
|
|
|
$fh->print($out || '') unless $state; # first output the current attempt
|
|
foreach $r (@$cache_list)
|
|
{
|
|
$offs = $r->[1];
|
|
foreach $t (@{$r->[0]{''}})
|
|
{
|
|
$str = "$t";
|
|
if (!defined $master_cache->{$str})
|
|
{
|
|
my ($vec) = $t->signature();
|
|
if ($vecs{$vec})
|
|
{ $master_cache->{$str} = $master_cache->{$vecs{$vec}}; }
|
|
else
|
|
{
|
|
$vecs{$vec} = $str;
|
|
$master_cache->{$str} = ($state ? length($out) : $fh->tell())
|
|
- $base_loc;
|
|
if ($state)
|
|
{ $out .= $t->out($fh, 1); }
|
|
else
|
|
{ $t->out($fh, 0); }
|
|
}
|
|
}
|
|
foreach (@{$r->[0]{$str}})
|
|
{
|
|
$s = pack($_->[1], $master_cache->{$str} - $offs);
|
|
substr($out, $_->[0], length($s)) = $s;
|
|
}
|
|
}
|
|
}
|
|
if ($state)
|
|
{ return $out; }
|
|
else
|
|
{
|
|
$loc = $fh->tell();
|
|
$fh->seek($base_loc, 0);
|
|
$fh->print($out || ''); # the corrected version
|
|
$fh->seek($loc, 0);
|
|
}
|
|
}
|
|
|
|
|
|
=head2 $self->read_context($lookup, $fh, $type, $fmt, $cover, $count, $loc)
|
|
|
|
Internal method to read context (simple and chaining context) lookup subtables for
|
|
the GSUB and GPOS table types. The assumed values for $type correspond to those
|
|
for GSUB, so GPOS should adjust the values upon calling.
|
|
|
|
=cut
|
|
|
|
sub read_context
|
|
{
|
|
my ($self, $lookup, $fh, $type, $fmt, $cover, $count, $loc) = @_;
|
|
my ($dat, $i, $s, $t, @subst, @srec, $mcount, $scount);
|
|
|
|
if ($type == 5 && $fmt < 3)
|
|
{
|
|
if ($fmt == 2)
|
|
{
|
|
$fh->read($dat, 2);
|
|
$lookup->{'CLASS'} = $self->read_cover($count, $loc, $lookup, $fh, 0);
|
|
$count = TTF_Unpack('S', $dat);
|
|
}
|
|
$fh->read($dat, $count << 1);
|
|
foreach $s (TTF_Unpack('S*', $dat))
|
|
{
|
|
if ($s == 0)
|
|
{
|
|
push (@{$lookup->{'RULES'}}, []);
|
|
next;
|
|
}
|
|
@subst = ();
|
|
$fh->seek($loc + $s, 0);
|
|
$fh->read($dat, 2);
|
|
$t = TTF_Unpack('S', $dat);
|
|
$fh->read($dat, $t << 1);
|
|
foreach $t (TTF_Unpack('S*', $dat))
|
|
{
|
|
$fh->seek($loc + $s + $t, 0);
|
|
@srec = ();
|
|
$fh->read($dat, 4);
|
|
($mcount, $scount) = TTF_Unpack('S2', $dat);
|
|
$mcount--;
|
|
$fh->read($dat, ($mcount << 1) + ($scount << 2));
|
|
for ($i = 0; $i < $scount; $i++)
|
|
{ push (@srec, [TTF_Unpack('S2', substr($dat,
|
|
($mcount << 1) + ($i << 2), 4))]); }
|
|
push (@subst, {'ACTION' => [@srec],
|
|
'MATCH' => [TTF_Unpack('S*',
|
|
substr($dat, 0, $mcount << 1))]});
|
|
}
|
|
push (@{$lookup->{'RULES'}}, [@subst]);
|
|
}
|
|
$lookup->{'ACTION_TYPE'} = 'l';
|
|
$lookup->{'MATCH_TYPE'} = ($fmt == 2 ? 'c' : 'g');
|
|
} elsif ($type == 5 && $fmt == 3)
|
|
{
|
|
$fh->read($dat, ($cover << 1) + ($count << 2));
|
|
@subst = (); @srec = ();
|
|
for ($i = 0; $i < $cover; $i++)
|
|
{ push (@subst, $self->read_cover(TTF_Unpack('S', substr($dat, $i << 1, 2)),
|
|
$loc, $lookup, $fh, 1)); }
|
|
for ($i = 0; $i < $count; $i++)
|
|
{ push (@srec, [TTF_Unpack('S2', substr($dat, ($count << 1) + ($i << 2), 4))]); }
|
|
$lookup->{'RULES'} = [[{'ACTION' => [@srec], 'MATCH' => [@subst]}]];
|
|
$lookup->{'ACTION_TYPE'} = 'l';
|
|
$lookup->{'MATCH_TYPE'} = 'o';
|
|
} elsif ($type == 6 && $fmt < 3)
|
|
{
|
|
if ($fmt == 2)
|
|
{
|
|
$fh->read($dat, 6);
|
|
$lookup->{'PRE_CLASS'} = $self->read_cover($count, $loc, $lookup, $fh, 0) if $count;
|
|
($i, $mcount, $count) = TTF_Unpack('S3', $dat); # messy: 2 classes & count
|
|
$lookup->{'CLASS'} = $self->read_cover($i, $loc, $lookup, $fh, 0) if $i;
|
|
$lookup->{'POST_CLASS'} = $self->read_cover($mcount, $loc, $lookup, $fh, 0) if $mcount;
|
|
}
|
|
$fh->read($dat, $count << 1);
|
|
foreach $s (TTF_Unpack('S*', $dat))
|
|
{
|
|
if ($s == 0)
|
|
{
|
|
push (@{$lookup->{'RULES'}}, []);
|
|
next;
|
|
}
|
|
@subst = ();
|
|
$fh->seek($loc + $s, 0);
|
|
$fh->read($dat, 2);
|
|
$t = TTF_Unpack('S', $dat);
|
|
$fh->read($dat, $t << 1);
|
|
foreach $i (TTF_Unpack('S*', $dat))
|
|
{
|
|
$fh->seek($loc + $s + $i, 0);
|
|
@srec = ();
|
|
$t = {};
|
|
$fh->read($dat, 2);
|
|
$mcount = TTF_Unpack('S', $dat);
|
|
if ($mcount > 0)
|
|
{
|
|
$fh->read($dat, $mcount << 1);
|
|
$t->{'PRE'} = [TTF_Unpack('S*', $dat)];
|
|
}
|
|
$fh->read($dat, 2);
|
|
$mcount = TTF_Unpack('S', $dat);
|
|
if ($mcount > 1)
|
|
{
|
|
$fh->read($dat, ($mcount - 1) << 1);
|
|
$t->{'MATCH'} = [TTF_Unpack('S*', $dat)];
|
|
}
|
|
$fh->read($dat, 2);
|
|
$mcount = TTF_Unpack('S', $dat);
|
|
if ($mcount > 0)
|
|
{
|
|
$fh->read($dat, $mcount << 1);
|
|
$t->{'POST'} = [TTF_Unpack('S*', $dat)];
|
|
}
|
|
$fh->read($dat, 2);
|
|
$scount = TTF_Unpack('S', $dat);
|
|
$fh->read($dat, $scount << 2);
|
|
for ($i = 0; $i < $scount; $i++)
|
|
{ push (@srec, [TTF_Unpack('S2', substr($dat, $i << 2))]); }
|
|
$t->{'ACTION'} = [@srec];
|
|
push (@subst, $t);
|
|
}
|
|
push (@{$lookup->{'RULES'}}, [@subst]);
|
|
}
|
|
$lookup->{'ACTION_TYPE'} = 'l';
|
|
$lookup->{'MATCH_TYPE'} = ($fmt == 2 ? 'c' : 'g');
|
|
} elsif ($type == 6 && $fmt == 3)
|
|
{
|
|
$t = {};
|
|
unless ($cover == 0)
|
|
{
|
|
@subst = ();
|
|
$fh->read($dat, $cover << 1);
|
|
foreach $s (TTF_Unpack('S*', $dat))
|
|
{ push(@subst, $self->read_cover($s, $loc, $lookup, $fh, 1)); }
|
|
$t->{'PRE'} = [@subst];
|
|
}
|
|
$fh->read($dat, 2);
|
|
$count = TTF_Unpack('S', $dat);
|
|
unless ($count == 0)
|
|
{
|
|
@subst = ();
|
|
$fh->read($dat, $count << 1);
|
|
foreach $s (TTF_Unpack('S*', $dat))
|
|
{ push(@subst, $self->read_cover($s, $loc, $lookup, $fh, 1)); }
|
|
$t->{'MATCH'} = [@subst];
|
|
}
|
|
$fh->read($dat, 2);
|
|
$count = TTF_Unpack('S', $dat);
|
|
unless ($count == 0)
|
|
{
|
|
@subst = ();
|
|
$fh->read($dat, $count << 1);
|
|
foreach $s (TTF_Unpack('S*', $dat))
|
|
{ push(@subst, $self->read_cover($s, $loc, $lookup, $fh, 1)); }
|
|
$t->{'POST'} = [@subst];
|
|
}
|
|
$fh->read($dat, 2);
|
|
$count = TTF_Unpack('S', $dat);
|
|
@subst = ();
|
|
$fh->read($dat, $count << 2);
|
|
for ($i = 0; $i < $count; $i++)
|
|
{ push (@subst, [TTF_Unpack('S2', substr($dat, $i << 2, 4))]); }
|
|
$t->{'ACTION'} = [@subst];
|
|
$lookup->{'RULES'} = [[$t]];
|
|
$lookup->{'ACTION_TYPE'} = 'l';
|
|
$lookup->{'MATCH_TYPE'} = 'o';
|
|
}
|
|
$lookup;
|
|
}
|
|
|
|
|
|
=head2 $self->out_context($lookup, $fh, $type, $fmt, $ctables, $out, $num)
|
|
|
|
Provides shared behaviour between GSUB and GPOS tables during output for context
|
|
(chained and simple) rules. In addition, support is provided here for type 4 GSUB
|
|
tables, which are not used in GPOS. The value for $type corresponds to the type
|
|
in a GSUB table so calling from GPOS should adjust the value accordingly.
|
|
|
|
=cut
|
|
|
|
sub out_context
|
|
{
|
|
my ($self, $lookup, $fh, $type, $fmt, $ctables, $out, $num, $base) = @_;
|
|
my ($offc, $offd, $i, $j, $r, $t, $numd);
|
|
|
|
$out ||= '';
|
|
if (($type == 4 || $type == 5 || $type == 6) && ($fmt == 1 || $fmt == 2))
|
|
{
|
|
my ($base_off);
|
|
|
|
if ($fmt == 1)
|
|
{
|
|
$out = pack("nnn", $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
|
|
$num);
|
|
$base_off = 6;
|
|
} elsif ($type == 5)
|
|
{
|
|
$out = pack("nnnn", $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
|
|
Font::TTF::Ttopen::ref_cache($lookup->{'CLASS'}, $ctables, 4 + $base), $num);
|
|
$base_off = 8;
|
|
} elsif ($type == 6)
|
|
{
|
|
$out = pack("n6", $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
|
|
Font::TTF::Ttopen::ref_cache($lookup->{'PRE_CLASS'}, $ctables, 4 + $base),
|
|
Font::TTF::Ttopen::ref_cache($lookup->{'CLASS'}, $ctables, 6 + $base),
|
|
Font::TTF::Ttopen::ref_cache($lookup->{'POST_CLASS'}, $ctables, 8 + $base),
|
|
$num);
|
|
$base_off = 12;
|
|
}
|
|
|
|
$out .= pack('n*', (0) x $num);
|
|
$offc = length($out);
|
|
for ($i = 0; $i < $num; $i++)
|
|
{
|
|
$r = $lookup->{'RULES'}[$i];
|
|
next unless exists $r->[0]{'ACTION'};
|
|
$numd = $#{$r} + 1;
|
|
substr($out, ($i << 1) + $base_off, 2) = pack('n', $offc);
|
|
$out .= pack('n*', $numd, (0) x $numd);
|
|
$offd = length($out) - $offc;
|
|
for ($j = 0; $j < $numd; $j++)
|
|
{
|
|
substr($out, $offc + 2 + ($j << 1), 2) = pack('n', $offd);
|
|
if ($type == 4)
|
|
{
|
|
$out .= pack('n*', $r->[$j]{'ACTION'}[0], $#{$r->[$j]{'MATCH'}} + 2,
|
|
@{$r->[$j]{'MATCH'}});
|
|
} elsif ($type == 5)
|
|
{
|
|
$out .= pack('n*', $#{$r->[$j]{'MATCH'}} + 2,
|
|
$#{$r->[$j]{'ACTION'}} + 1,
|
|
@{$r->[$j]{'MATCH'}});
|
|
foreach $t (@{$r->[$j]{'ACTION'}})
|
|
{ $out .= pack('n2', @$t); }
|
|
} elsif ($type == 6)
|
|
{
|
|
$out .= pack('n*', $#{$r->[$j]{'PRE'}} + 1, @{$r->[$j]{'PRE'}},
|
|
$#{$r->[$j]{'MATCH'}} + 2, @{$r->[$j]{'MATCH'}},
|
|
$#{$r->[$j]{'POST'}} + 1, @{$r->[$j]{'POST'}},
|
|
$#{$r->[$j]{'ACTION'}} + 1);
|
|
foreach $t (@{$r->[$j]{'ACTION'}})
|
|
{ $out .= pack('n2', @$t); }
|
|
}
|
|
$offd = length($out) - $offc;
|
|
}
|
|
$offc = length($out);
|
|
}
|
|
} elsif ($type == 5 && $fmt == 3)
|
|
{
|
|
$out .= pack('n3', $fmt, $#{$lookup->{'RULES'}[0][0]{'MATCH'}} + 1,
|
|
$#{$lookup->{'RULES'}[0][0]{'ACTION'}} + 1);
|
|
foreach $t (@{$lookup->{'RULES'}[0][0]{'MATCH'}})
|
|
{ $out .= pack('n', Font::TTF::Ttopen::ref_cache($t, $ctables, length($out) + $base)); }
|
|
foreach $t (@{$lookup->{'RULES'}[0][0]{'ACTION'}})
|
|
{ $out .= pack('n2', @$t); }
|
|
} elsif ($type == 6 && $fmt == 3)
|
|
{
|
|
$r = $lookup->{'RULES'}[0][0];
|
|
no strict 'refs'; # temp fix - more code needed (probably "if" statements in the event 'PRE' or 'POST' are empty)
|
|
$out .= pack('n2', $fmt, defined $r->{'PRE'} ? scalar @{$r->{'PRE'}} : 0);
|
|
foreach $t (@{$r->{'PRE'}})
|
|
{ $out .= pack('n', Font::TTF::Ttopen::ref_cache($t, $ctables, length($out) + $base)); }
|
|
$out .= pack('n', defined $r->{'MATCH'} ? scalar @{$r->{'MATCH'}} : 0);
|
|
foreach $t (@{$r->{'MATCH'}})
|
|
{ $out .= pack('n', Font::TTF::Ttopen::ref_cache($t, $ctables, length($out) + $base)); }
|
|
$out .= pack('n', defined $r->{'POST'} ? scalar @{$r->{'POST'}} : 0);
|
|
foreach $t (@{$r->{'POST'}})
|
|
{ $out .= pack('n', Font::TTF::Ttopen::ref_cache($t, $ctables, length($out) + $base)); }
|
|
$out .= pack('n', defined $r->{'ACTION'} ? scalar @{$r->{'ACTION'}} : 0);
|
|
foreach $t (@{$r->{'ACTION'}})
|
|
{ $out .= pack('n2', @$t); }
|
|
}
|
|
$out;
|
|
}
|
|
|
|
1;
|
|
|
|
|
|
=head1 BUGS
|
|
|
|
=over 4
|
|
|
|
=item *
|
|
|
|
No way to share cachable items (coverage tables, classes, anchors, device tables)
|
|
across different lookups. The items are always output after the lookup and
|
|
repeated if necessary. Within lookup sharing is possible.
|
|
|
|
=back
|
|
|
|
=head1 AUTHOR
|
|
|
|
Martin Hosken L<http://scripts.sil.org/FontUtils>.
|
|
|
|
|
|
=head1 LICENSING
|
|
|
|
Copyright (c) 1998-2016, SIL International (http://www.sil.org)
|
|
|
|
This module is released under the terms of the Artistic License 2.0.
|
|
For details, see the full text of the license in the file LICENSE.
|
|
|
|
|
|
|
|
=cut
|
|
|