Blame lib/Font/TTF/Cmap.pm

Packit 5d935b
package Font::TTF::Cmap;
Packit 5d935b
Packit 5d935b
=head1 NAME
Packit 5d935b
Packit 5d935b
Font::TTF::Cmap - Character map table
Packit 5d935b
Packit 5d935b
=head1 DESCRIPTION
Packit 5d935b
Packit 5d935b
Looks after the character map. For ease of use, the actual cmap is held in
Packit 5d935b
a hash against codepoint. Thus for a given table:
Packit 5d935b
Packit 5d935b
    $gid = $font->{'cmap'}{'Tables'}[0]{'val'}{$code};
Packit 5d935b
Packit 5d935b
Note that C<$code> should be a true value (0x1234) rather than a string representation.
Packit 5d935b
Packit 5d935b
=head1 INSTANCE VARIABLES
Packit 5d935b
Packit 5d935b
The instance variables listed here are not preceded by a space due to their
Packit 5d935b
emulating structural information in the font.
Packit 5d935b
Packit 5d935b
=over 4
Packit 5d935b
Packit 5d935b
=item Num
Packit 5d935b
Packit 5d935b
Number of subtables in this table
Packit 5d935b
Packit 5d935b
=item Tables
Packit 5d935b
Packit 5d935b
An array of subtables ([0..Num-1])
Packit 5d935b
Packit 5d935b
Each subtable also has its own instance variables which are, again, not
Packit 5d935b
preceded by a space.
Packit 5d935b
Packit 5d935b
=over 4
Packit 5d935b
Packit 5d935b
=item Platform
Packit 5d935b
Packit 5d935b
The platform number for this subtable
Packit 5d935b
Packit 5d935b
=item Encoding
Packit 5d935b
Packit 5d935b
The encoding number for this subtable
Packit 5d935b
Packit 5d935b
=item Format
Packit 5d935b
Packit 5d935b
Gives the stored format of this subtable
Packit 5d935b
Packit 5d935b
=item Ver
Packit 5d935b
Packit 5d935b
Gives the version (or language) information for this subtable
Packit 5d935b
Packit 5d935b
=item val
Packit 5d935b
Packit 5d935b
A hash keyed by the codepoint value (not a string) storing the glyph id
Packit 5d935b
Packit 5d935b
=back
Packit 5d935b
Packit 5d935b
=back
Packit 5d935b
Packit 5d935b
The following cmap options are controlled by instance variables that start with a space:
Packit 5d935b
Packit 5d935b
=over 4
Packit 5d935b
Packit 5d935b
=item allowholes
Packit 5d935b
Packit 5d935b
By default, when generating format 4 cmap subtables character codes that point to glyph zero
Packit 5d935b
(normally called .notdef) are not included in the subtable. In some cases including some of these
Packit 5d935b
character codes can result in a smaller format 4 subtable. To enable this behavior, set allowholes 
Packit 5d935b
to non-zero. 
Packit 5d935b
Packit 5d935b
=back
Packit 5d935b
Packit 5d935b
=head1 METHODS
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
use strict;
Packit 5d935b
use vars qw(@ISA);
Packit 5d935b
use Font::TTF::Table;
Packit 5d935b
use Font::TTF::Utils;
Packit 5d935b
Packit 5d935b
@ISA = qw(Font::TTF::Table);
Packit 5d935b
Packit 5d935b
Packit 5d935b
=head2 $t->read
Packit 5d935b
Packit 5d935b
Reads the cmap into memory. Format 4 subtables read the whole subtable and
Packit 5d935b
fill in the segmented array accordingly.
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub read
Packit 5d935b
{
Packit 5d935b
    my ($self, $keepzeros) = @_;
Packit 5d935b
    $self->SUPER::read or return $self;
Packit 5d935b
Packit 5d935b
    my ($dat, $i, $j, $k, $id, @ids, $s);
Packit 5d935b
    my ($start, $end, $range, $delta, $form, $len, $num, $ver, $sg);
Packit 5d935b
    my ($fh) = $self->{' INFILE'};
Packit 5d935b
Packit 5d935b
    $fh->read($dat, 4);
Packit 5d935b
    $self->{'Num'} = unpack("x2n", $dat);
Packit 5d935b
    $self->{'Tables'} = [];
Packit 5d935b
    for ($i = 0; $i < $self->{'Num'}; $i++)
Packit 5d935b
    {
Packit 5d935b
        $s = {};
Packit 5d935b
        $fh->read($dat, 8);
Packit 5d935b
        ($s->{'Platform'}, $s->{'Encoding'}, $s->{'LOC'}) = (unpack("nnN", $dat));
Packit 5d935b
        $s->{'LOC'} += $self->{' OFFSET'};
Packit 5d935b
        push(@{$self->{'Tables'}}, $s);
Packit 5d935b
    }
Packit 5d935b
    for ($i = 0; $i < $self->{'Num'}; $i++)
Packit 5d935b
    {
Packit 5d935b
        $s = $self->{'Tables'}[$i];
Packit 5d935b
        $fh->seek($s->{'LOC'}, 0);
Packit 5d935b
        $fh->read($dat, 2);
Packit 5d935b
        $form = unpack("n", $dat);
Packit 5d935b
Packit 5d935b
        $s->{'Format'} = $form;
Packit 5d935b
        if ($form == 0)
Packit 5d935b
        {
Packit 5d935b
            my $j = 0;
Packit 5d935b
Packit 5d935b
            $fh->read($dat, 4);
Packit 5d935b
            ($len, $s->{'Ver'}) = unpack('n2', $dat);
Packit 5d935b
            $fh->read($dat, 256);
Packit 5d935b
            $s->{'val'} = {map {$j++; ($_ ? ($j - 1, $_) : ())} unpack("C*", $dat)};
Packit 5d935b
        } elsif ($form == 6)
Packit 5d935b
        {
Packit 5d935b
            my ($start, $ecount);
Packit 5d935b
            
Packit 5d935b
            $fh->read($dat, 8);
Packit 5d935b
            ($len, $s->{'Ver'}, $start, $ecount) = unpack('n4', $dat);
Packit 5d935b
            $fh->read($dat, $ecount << 1);
Packit 5d935b
            $s->{'val'} = {map {$start++; ($_ ? ($start - 1, $_) : ())} unpack("n*", $dat)};
Packit 5d935b
        } elsif ($form == 2)        # Contributed by Huw Rogers
Packit 5d935b
        {
Packit 5d935b
            $fh->read($dat, 4);
Packit 5d935b
            ($len, $s->{'Ver'}) = unpack('n2', $dat);
Packit 5d935b
            $fh->read($dat, 512);
Packit 5d935b
            my ($j, $k, $l, $m, $n, @subHeaderKeys, @subHeaders, $subHeader);
Packit 5d935b
            $n = 1;
Packit 5d935b
            for ($j = 0; $j < 256; $j++) {
Packit 5d935b
                my $k = unpack('@'.($j<<1).'n', $dat)>>3;
Packit 5d935b
                $n = $k + 1 if $k >= $n;
Packit 5d935b
                $subHeaders[$subHeaderKeys[$j] = $k] ||= [ ];
Packit 5d935b
            }
Packit 5d935b
            $fh->read($dat, $n<<3); # read subHeaders[]
Packit 5d935b
            for ($k = 0; $k < $n; $k++) {
Packit 5d935b
                $subHeader = $subHeaders[$k];
Packit 5d935b
                $l = $k<<3;
Packit 5d935b
                @$subHeader = unpack('@'.$l.'n4', $dat);
Packit 5d935b
                $subHeader->[2] = unpack('s', pack('S', $subHeader->[2]))
Packit 5d935b
                    if $subHeader->[2] & 0x8000; # idDelta
Packit 5d935b
                $subHeader->[3] =
Packit 5d935b
                    ($subHeader->[3] - (($n - $k)<<3) + 6)>>1; # idRangeOffset
Packit 5d935b
            }
Packit 5d935b
            $fh->read($dat, $len - ($n<<3) - 518); # glyphIndexArray[]
Packit 5d935b
            for ($j = 0; $j < 256; $j++) {
Packit 5d935b
                $k = $subHeaderKeys[$j];
Packit 5d935b
                $subHeader = $subHeaders[$k];
Packit 5d935b
                unless ($k) {
Packit 5d935b
                    $l = $j - $subHeader->[0];
Packit 5d935b
                    if ($l >= 0 && $l < $subHeader->[1]) {
Packit 5d935b
                        $m = unpack('@'.(($l + $subHeader->[3])<<1).'n', $dat);
Packit 5d935b
                        $m += $subHeader->[2] if $m;
Packit 5d935b
                        $s->{'val'}{$j} = $m;
Packit 5d935b
                    }
Packit 5d935b
                } else {
Packit 5d935b
                    for ($l = 0; $l < $subHeader->[1]; $l++) {
Packit 5d935b
                        $m = unpack('@'.(($l + $subHeader->[3])<<1).'n', $dat);
Packit 5d935b
                        $m += $subHeader->[2] if $m;
Packit 5d935b
                        $s->{'val'}{($j<<8) + $l + $subHeader->[0]} = $m;
Packit 5d935b
                    }
Packit 5d935b
                }
Packit 5d935b
            }
Packit 5d935b
        } elsif ($form == 4)
Packit 5d935b
        {
Packit 5d935b
            $fh->read($dat, 12);
Packit 5d935b
            ($len, $s->{'Ver'}, $num) = unpack('n3', $dat);
Packit 5d935b
            $num >>= 1;
Packit 5d935b
            $fh->read($dat, $len - 14);
Packit 5d935b
            for ($j = 0; $j < $num; $j++)
Packit 5d935b
            {
Packit 5d935b
                $end = unpack("n", substr($dat, $j << 1, 2));
Packit 5d935b
                $start = unpack("n", substr($dat, ($j << 1) + ($num << 1) + 2, 2));
Packit 5d935b
                $delta = unpack("n", substr($dat, ($j << 1) + ($num << 2) + 2, 2));
Packit 5d935b
                $delta -= 65536 if $delta > 32767;
Packit 5d935b
                $range = unpack("n", substr($dat, ($j << 1) + $num * 6 + 2, 2));
Packit 5d935b
                for ($k = $start; $k <= $end; $k++)
Packit 5d935b
                {
Packit 5d935b
                    if ($range == 0 || $range == 65535)         # support the buggy FOG with its range=65535 for final segment
Packit 5d935b
                    { $id = $k + $delta; }
Packit 5d935b
                    else
Packit 5d935b
                    { $id = unpack("n", substr($dat, ($j << 1) + $num * 6 +
Packit 5d935b
                                        2 + ($k - $start) * 2 + $range, 2)) + $delta; }
Packit 5d935b
                    $id -= 65536 if $id >= 65536;
Packit 5d935b
                    $s->{'val'}{$k} = $id if ($id || $keepzeros);
Packit 5d935b
                }
Packit 5d935b
            }
Packit 5d935b
        } elsif ($form == 8 || $form == 12 || $form == 13)
Packit 5d935b
        {
Packit 5d935b
            $fh->read($dat, 10);
Packit 5d935b
            ($len, $s->{'Ver'}) = unpack('x2N2', $dat);
Packit 5d935b
            if ($form == 8)
Packit 5d935b
            {
Packit 5d935b
                $fh->read($dat, 8196);
Packit 5d935b
                $num = unpack("N", substr($dat, 8192, 4)); # don't need the map
Packit 5d935b
            } else
Packit 5d935b
            {
Packit 5d935b
                $fh->read($dat, 4);
Packit 5d935b
                $num = unpack("N", $dat);
Packit 5d935b
            }
Packit 5d935b
            $fh->read($dat, 12 * $num);
Packit 5d935b
            for ($j = 0; $j < $num; $j++)
Packit 5d935b
            {
Packit 5d935b
                ($start, $end, $sg) = unpack("N3", substr($dat, $j * 12, 12));
Packit 5d935b
                for ($k = $start; $k <= $end; $k++)
Packit 5d935b
                { $s->{'val'}{$k} = $form == 13 ? $sg : $sg++; }
Packit 5d935b
            }
Packit 5d935b
        } elsif ($form == 10)
Packit 5d935b
        {
Packit 5d935b
            $fh->read($dat, 18);
Packit 5d935b
            ($len, $s->{'Ver'}, $start, $num) = unpack('x2N4', $dat);
Packit 5d935b
            $fh->read($dat, $num << 1);
Packit 5d935b
            for ($j = 0; $j < $num; $j++)
Packit 5d935b
            { $s->{'val'}{$start + $j} = unpack("n", substr($dat, $j << 1, 2)); }
Packit 5d935b
        }
Packit 5d935b
    }
Packit 5d935b
    $self;
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
Packit 5d935b
=head2 $t->ms_lookup($uni)
Packit 5d935b
Packit 5d935b
Finds a Unicode table, giving preference to the MS one, and looks up the given
Packit 5d935b
Unicode codepoint in it to find the glyph id.
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub ms_lookup
Packit 5d935b
{
Packit 5d935b
    my ($self, $uni) = @_;
Packit 5d935b
Packit 5d935b
    $self->find_ms || return undef unless (defined $self->{' mstable'});
Packit 5d935b
    return $self->{' mstable'}{'val'}{$uni};
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
Packit 5d935b
=head2 $t->find_ms
Packit 5d935b
Packit 5d935b
Finds the a Unicode table, giving preference to the Microsoft one, and sets the C<mstable> instance variable
Packit 5d935b
to it if found. Returns the table it finds.
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub find_ms
Packit 5d935b
{
Packit 5d935b
    my ($self) = @_;
Packit 5d935b
    my ($i, $s, $alt, $found);
Packit 5d935b
Packit 5d935b
    return $self->{' mstable'} if defined $self->{' mstable'};
Packit 5d935b
    $self->read;
Packit 5d935b
    for ($i = 0; $i < $self->{'Num'}; $i++)
Packit 5d935b
    {
Packit 5d935b
        $s = $self->{'Tables'}[$i];
Packit 5d935b
        if ($s->{'Platform'} == 3)
Packit 5d935b
        {
Packit 5d935b
            $self->{' mstable'} = $s;
Packit 5d935b
            return $s if ($s->{'Encoding'} == 10);
Packit 5d935b
            $found = 1 if ($s->{'Encoding'} == 1);
Packit 5d935b
        } elsif ($s->{'Platform'} == 0 || ($s->{'Platform'} == 2 && $s->{'Encoding'} == 1))
Packit 5d935b
        { $alt = $s; }
Packit 5d935b
    }
Packit 5d935b
    $self->{' mstable'} = $alt if ($alt && !$found);
Packit 5d935b
    $self->{' mstable'};
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
Packit 5d935b
=head2 $t->ms_enc
Packit 5d935b
Packit 5d935b
Returns the encoding of the microsoft table (0 => symbol, etc.). Returns undef if there is
Packit 5d935b
no Microsoft cmap.
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub ms_enc
Packit 5d935b
{
Packit 5d935b
    my ($self) = @_;
Packit 5d935b
    my ($s);
Packit 5d935b
    
Packit 5d935b
    return $self->{' mstable'}{'Encoding'} 
Packit 5d935b
        if (defined $self->{' mstable'} && $self->{' mstable'}{'Platform'} == 3);
Packit 5d935b
    
Packit 5d935b
    foreach $s (@{$self->{'Tables'}})
Packit 5d935b
    {
Packit 5d935b
        return $s->{'Encoding'} if ($s->{'Platform'} == 3);
Packit 5d935b
    }
Packit 5d935b
    return undef;
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
Packit 5d935b
=head2 $t->out($fh)
Packit 5d935b
Packit 5d935b
Writes out a cmap table to a filehandle. If it has not been read, then
Packit 5d935b
just copies from input file to output
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub out
Packit 5d935b
{
Packit 5d935b
    my ($self, $fh) = @_;
Packit 5d935b
    my ($loc, $s, $i, $base_loc, $j, @keys);
Packit 5d935b
Packit 5d935b
    return $self->SUPER::out($fh) unless $self->{' read'};
Packit 5d935b
Packit 5d935b
Packit 5d935b
    $self->{'Tables'} = [sort {$a->{'Platform'} <=> $b->{'Platform'}
Packit 5d935b
                                || $a->{'Encoding'} <=> $b->{'Encoding'}
Packit 5d935b
                                || $a->{'Ver'} <=> $b->{'Ver'}} @{$self->{'Tables'}}];
Packit 5d935b
    $self->{'Num'} = scalar @{$self->{'Tables'}};
Packit 5d935b
Packit 5d935b
    $base_loc = $fh->tell();
Packit 5d935b
    $fh->print(pack("n2", 0, $self->{'Num'}));
Packit 5d935b
Packit 5d935b
    for ($i = 0; $i < $self->{'Num'}; $i++)
Packit 5d935b
    { $fh->print(pack("nnN", $self->{'Tables'}[$i]{'Platform'}, $self->{'Tables'}[$i]{'Encoding'}, 0)); }
Packit 5d935b
Packit 5d935b
    for ($i = 0; $i < $self->{'Num'}; $i++)
Packit 5d935b
    {
Packit 5d935b
        $s = $self->{'Tables'}[$i];
Packit 5d935b
        if ($s->{'Format'} < 8)
Packit 5d935b
        { @keys = sort {$a <=> $b} grep { $_ <= 0xFFFF} keys %{$s->{'val'}}; }
Packit 5d935b
        else
Packit 5d935b
        { @keys = sort {$a <=> $b} keys %{$s->{'val'}}; }
Packit 5d935b
        $s->{' outloc'} = $fh->tell();
Packit 5d935b
        if ($s->{'Format'} < 8)
Packit 5d935b
        { $fh->print(pack("n3", $s->{'Format'}, 0, $s->{'Ver'})); }       # come back for length
Packit 5d935b
        else
Packit 5d935b
        { $fh->print(pack("n2N2", $s->{'Format'}, 0, 0, $s->{'Ver'})); }
Packit 5d935b
            
Packit 5d935b
        if ($s->{'Format'} == 0)
Packit 5d935b
        {
Packit 5d935b
            $fh->print(pack("C256", map {defined $_ ? $_ : 0} @{$s->{'val'}}{0 .. 255}));
Packit 5d935b
        } elsif ($s->{'Format'} == 6)
Packit 5d935b
        {
Packit 5d935b
            $fh->print(pack("n2", $keys[0], $keys[-1] - $keys[0] + 1));
Packit 5d935b
            $fh->print(pack("n*", map {defined $_ ? $_ : 0} @{$s->{'val'}}{$keys[0] .. $keys[-1]}));
Packit 5d935b
        } elsif ($s->{'Format'} == 2)       # Contributed by Huw Rogers
Packit 5d935b
        {
Packit 5d935b
            my ($g, $k, $h, $l, $m, $n);
Packit 5d935b
            my (@subHeaderKeys, @subHeaders, $subHeader, @glyphIndexArray);
Packit 5d935b
            $n = 0;
Packit 5d935b
            @subHeaderKeys = (-1) x 256;
Packit 5d935b
            for $j (@keys) {
Packit 5d935b
                next unless defined($g = $s->{'val'}{$j});
Packit 5d935b
                $h = int($j>>8);
Packit 5d935b
                $l = ($j & 0xff);
Packit 5d935b
                if (($k = $subHeaderKeys[$h]) < 0) {
Packit 5d935b
                    $subHeader = [ $l, 1, 0, 0, [ $g ] ];
Packit 5d935b
                    $subHeaders[$k = $n++] = $subHeader;
Packit 5d935b
                    $subHeaderKeys[$h] = $k;
Packit 5d935b
                } else {
Packit 5d935b
                    $subHeader = $subHeaders[$k];
Packit 5d935b
                    $m = ($l - $subHeader->[0] + 1) - $subHeader->[1];
Packit 5d935b
                    $subHeader->[1] += $m;
Packit 5d935b
                    push @{$subHeader->[4]}, (0) x ($m - 1), $g - $subHeader->[2];
Packit 5d935b
                }
Packit 5d935b
            }
Packit 5d935b
            @subHeaderKeys = map { $_ < 0 ? 0 : $_ } @subHeaderKeys;
Packit 5d935b
            $subHeader = $subHeaders[0];
Packit 5d935b
            $subHeader->[3] = 0;
Packit 5d935b
            push @glyphIndexArray, @{$subHeader->[4]};
Packit 5d935b
            splice(@$subHeader, 4);
Packit 5d935b
            {
Packit 5d935b
                my @subHeaders_ = sort {@{$a->[4]} <=> @{$b->[4]}} @subHeaders[1..$#subHeaders];
Packit 5d935b
                my ($f, $d, $r, $subHeader_);
Packit 5d935b
                for ($k = 0; $k < @subHeaders_; $k++) {
Packit 5d935b
                    $subHeader = $subHeaders_[$k];
Packit 5d935b
                    $f = $r = shift @{$subHeader->[4]};
Packit 5d935b
                    $subHeader->[5] = join(':',
Packit 5d935b
                        map {
Packit 5d935b
                            $d = $_ - $r;
Packit 5d935b
                            $r = $_;
Packit 5d935b
                            $d < 0 ?
Packit 5d935b
                                sprintf('-%04x', -$d) :
Packit 5d935b
                                sprintf('+%04x', $d)
Packit 5d935b
                        } @{$subHeader->[4]});
Packit 5d935b
                    unshift @{$subHeader->[4]}, $f;
Packit 5d935b
                }
Packit 5d935b
                for ($k = 0; $k < @subHeaders_; $k++) {
Packit 5d935b
                    $subHeader = $subHeaders_[$k];
Packit 5d935b
                    next unless $subHeader->[4];
Packit 5d935b
                    $subHeader->[3] = @glyphIndexArray;
Packit 5d935b
                    push @glyphIndexArray, @{$subHeader->[4]};
Packit 5d935b
                    for ($l = $k + 1; $l < @subHeaders_; $l++) {
Packit 5d935b
                        $subHeader_ = $subHeaders_[$l];
Packit 5d935b
                        next unless $subHeader_->[4];
Packit 5d935b
                        $d = $subHeader_->[5];
Packit 5d935b
                        if ($subHeader->[5] =~ /\Q$d\E/) {
Packit 5d935b
                            my $o = length($`)/6;               #`
Packit 5d935b
                            $subHeader_->[2] +=
Packit 5d935b
                                $subHeader_->[4]->[$o] - $subHeader->[4]->[0];
Packit 5d935b
                            $subHeader_->[3] = $subHeader->[3] + $o;
Packit 5d935b
                            splice(@$subHeader_, 4);
Packit 5d935b
                        }
Packit 5d935b
                    }
Packit 5d935b
                    splice(@$subHeader, 4);
Packit 5d935b
                }
Packit 5d935b
            }
Packit 5d935b
            $fh->print(pack('n*', map { $_<<3 } @subHeaderKeys));
Packit 5d935b
            for ($j = 0; $j < 256; $j++) {
Packit 5d935b
                $k = $subHeaderKeys[$j];
Packit 5d935b
                $subHeader = $subHeaders[$k];
Packit 5d935b
            }
Packit 5d935b
            for ($k = 0; $k < $n; $k++) {
Packit 5d935b
                $subHeader = $subHeaders[$k];
Packit 5d935b
                $fh->print(pack('n4',
Packit 5d935b
                    $subHeader->[0],
Packit 5d935b
                    $subHeader->[1],
Packit 5d935b
                    $subHeader->[2] < 0 ?
Packit 5d935b
                        unpack('S', pack('s', $subHeader->[2])) :
Packit 5d935b
                        $subHeader->[2],
Packit 5d935b
                    ($subHeader->[3]<<1) + (($n - $k)<<3) - 6
Packit 5d935b
                ));
Packit 5d935b
            }
Packit 5d935b
            $fh->print(pack('n*', @glyphIndexArray));
Packit 5d935b
        } elsif ($s->{'Format'} == 4)
Packit 5d935b
        {
Packit 5d935b
            my (@starts, @ends, @deltas, @range);
Packit 5d935b
Packit 5d935b
            # There appears to be a bug in Windows that requires the final 0xFFFF (sentry)
Packit 5d935b
            # to be in a segment by itself -- otherwise Windows 7 and 8 (at least) won't install
Packit 5d935b
            # or preview the font, complaining that it doesn't appear to be a valid font.
Packit 5d935b
            # Therefore we can't just add 0XFFFF to the USV list as we used to do:
Packit 5d935b
            # push(@keys, 0xFFFF) unless ($keys[-1] == 0xFFFF);
Packit 5d935b
            # Instead, for now *remove* 0xFFFF from the USV list, and add a segement
Packit 5d935b
            # for it after all the other segments are computed.
Packit 5d935b
            pop @keys if $keys[-1] == 0xFFFF;
Packit 5d935b
            
Packit 5d935b
            # Step 1: divide into maximal length idDelta runs
Packit 5d935b
            
Packit 5d935b
            my ($prevUSV, $prevgid);
Packit 5d935b
            for ($j = 0; $j <= $#keys; $j++)
Packit 5d935b
            {
Packit 5d935b
                my $u = $keys[$j];
Packit 5d935b
                my $g = $s->{'val'}{$u};
Packit 5d935b
                if ($j == 0 || $u != $prevUSV+1 || $g != $prevgid+1)
Packit 5d935b
                {
Packit 5d935b
                    push @ends, $prevUSV unless $j == 0;
Packit 5d935b
                    push @starts, $u;
Packit 5d935b
                    push @range, 0;
Packit 5d935b
                }
Packit 5d935b
                $prevUSV = $u;
Packit 5d935b
                $prevgid = $g;
Packit 5d935b
            }
Packit 5d935b
            push @ends, $prevUSV;
Packit 5d935b
            
Packit 5d935b
            # Step 2: find each macro-range
Packit 5d935b
            
Packit 5d935b
            my ($start, $end);  # Start and end of macro-range
Packit 5d935b
            for ($start = 0; $start < $#starts; $start++)
Packit 5d935b
            {
Packit 5d935b
                next if $ends[$start] - $starts[$start]  >  7;      # if count > 8, we always treat this as a run unto itself
Packit 5d935b
                for ($end = $start+1; $end <= $#starts; $end++)
Packit 5d935b
                {
Packit 5d935b
                    last if $starts[$end] - $ends[$end-1] > ($self->{' allowholes'} ? 5 : 1) 
Packit 5d935b
                        || $ends[$end] - $starts[$end] > 7;   # gap > 4 or count > 8 so $end is beyond end of macro-range
Packit 5d935b
                }
Packit 5d935b
                $end--; #Ending index of this macro-range
Packit 5d935b
                
Packit 5d935b
                # Step 3: optimize this macro-range (from $start through $end)
Packit 5d935b
                L1: for ($j = $start; $j < $end; )
Packit 5d935b
                {
Packit 5d935b
                    my $size1 = ($range[$j] ? 8 + 2 * ($ends[$j] - $starts[$j] + 1) : 8); # size of first range (which may now be idRange type)
Packit 5d935b
                    for (my $k = $j+1; $k <= $end; $k++)
Packit 5d935b
                    {
Packit 5d935b
                        if (8 + 2 * ($ends[$k] - $starts[$j] + 1) <= $size1 + 8 * ($k - $j))
Packit 5d935b
                        {
Packit 5d935b
                            # Need to coalesce $j..$k into $j:
Packit 5d935b
                            $ends[$j] = $ends[$k];
Packit 5d935b
                            $range[$j] = 1;         # for now use boolean to indicate this is an idRange segment
Packit 5d935b
                            splice @starts, $j+1, $k-$j;
Packit 5d935b
                            splice @ends,   $j+1, $k-$j;
Packit 5d935b
                            splice @range,  $j+1, $k-$j;
Packit 5d935b
                            $end -= ($k-$j);
Packit 5d935b
                            next L1;    # Note that $j isn't incremented so this is a redo
Packit 5d935b
                        }
Packit 5d935b
                    }
Packit 5d935b
                    # Nothing coalesced
Packit 5d935b
                    $j++;
Packit 5d935b
                }
Packit 5d935b
                
Packit 5d935b
                # Finished with this macro-range
Packit 5d935b
                $start = $end;
Packit 5d935b
            }
Packit 5d935b
Packit 5d935b
            # Ok, add the final segment containing the sentry value
Packit 5d935b
            push(@keys, 0xFFFF);
Packit 5d935b
            push @starts, 0xFFFF;
Packit 5d935b
            push @ends, 0xFFFF;
Packit 5d935b
            push @range, 0;
Packit 5d935b
            
Packit 5d935b
            # What is left is a collection of segments that will represent the cmap in mimimum-sized format 4 subtable
Packit 5d935b
            
Packit 5d935b
            my ($num, $count, $sRange, $eSel, $eShift);
Packit 5d935b
Packit 5d935b
            $num = scalar(@starts);
Packit 5d935b
            $count = 0;
Packit 5d935b
            for ($j = 0; $j < $num; $j++)
Packit 5d935b
            {
Packit 5d935b
                if ($range[$j])
Packit 5d935b
                {
Packit 5d935b
                    $range[$j] = ($count + $num - $j) << 1;
Packit 5d935b
                    $count += $ends[$j] - $starts[$j] + 1;
Packit 5d935b
                    push @deltas, 0;
Packit 5d935b
                }
Packit 5d935b
                else
Packit 5d935b
                {
Packit 5d935b
                    push @deltas, ($s->{'val'}{$starts[$j]} || 0) - $starts[$j];
Packit 5d935b
                }
Packit 5d935b
            }
Packit 5d935b
Packit 5d935b
            ($num, $sRange, $eSel, $eShift) = Font::TTF::Utils::TTF_bininfo($num, 2);
Packit 5d935b
            $fh->print(pack("n4", $num * 2, $sRange, $eSel, $eShift));
Packit 5d935b
            $fh->print(pack("n*", @ends));
Packit 5d935b
            $fh->print(pack("n", 0));
Packit 5d935b
            $fh->print(pack("n*", @starts));
Packit 5d935b
            $fh->print(pack("n*", @deltas));
Packit 5d935b
            $fh->print(pack("n*", @range));
Packit 5d935b
Packit 5d935b
            for ($j = 0; $j < $num; $j++)
Packit 5d935b
            {
Packit 5d935b
                next if ($range[$j] == 0);
Packit 5d935b
                $fh->print(pack("n*", map {$_ || 0} @{$s->{'val'}}{$starts[$j] .. $ends[$j]}));
Packit 5d935b
            }
Packit 5d935b
        } elsif ($s->{'Format'} == 8 || $s->{'Format'} == 12 || $s->{'Format'} == 13)
Packit 5d935b
        {
Packit 5d935b
            my (@jobs, $start, $current, $curr_glyf, $map);
Packit 5d935b
            
Packit 5d935b
            $current = 0; $curr_glyf = 0;
Packit 5d935b
            $map = "\000" x 8192;
Packit 5d935b
            foreach $j (@keys)
Packit 5d935b
            {
Packit 5d935b
                if ($j > 0xFFFF && $s->{'Format'} == 8)
Packit 5d935b
                {
Packit 5d935b
                    if (defined $s->{'val'}{$j >> 16})
Packit 5d935b
                    { $s->{'Format'} = 12; }
Packit 5d935b
                    vec($map, $j >> 16, 1) = 1;
Packit 5d935b
                }
Packit 5d935b
                if ($j != $current + 1 || $s->{'val'}{$j} != ($s->{'Format'} == 13 ? $curr_glyf : $curr_glyf + 1))
Packit 5d935b
                {
Packit 5d935b
                    push (@jobs, [$start, $current, $s->{'Format'} == 13 ? $curr_glyf : $curr_glyf - ($current - $start)]) if (defined $start);
Packit 5d935b
                    $start = $j; $current = $j; $curr_glyf = $s->{'val'}{$j};
Packit 5d935b
                }
Packit 5d935b
                $current = $j;
Packit 5d935b
                $curr_glyf = $s->{'val'}{$j};
Packit 5d935b
            }
Packit 5d935b
            push (@jobs, [$start, $current, $s->{'Format'} == 13 ? $curr_glyf : $curr_glyf - ($current - $start)]) if (defined $start);
Packit 5d935b
            $fh->print($map) if ($s->{'Format'} == 8);
Packit 5d935b
            $fh->print(pack('N', $#jobs + 1));
Packit 5d935b
            foreach $j (@jobs)
Packit 5d935b
            { $fh->print(pack('N3', @{$j})); }
Packit 5d935b
        } elsif ($s->{'Format'} == 10)
Packit 5d935b
        {
Packit 5d935b
            $fh->print(pack('N2', $keys[0], $keys[-1] - $keys[0] + 1));
Packit 5d935b
            $fh->print(pack('n*', $s->{'val'}{$keys[0] .. $keys[-1]}));
Packit 5d935b
        }
Packit 5d935b
Packit 5d935b
        $loc = $fh->tell();
Packit 5d935b
        if ($s->{'Format'} < 8)
Packit 5d935b
        {
Packit 5d935b
            $fh->seek($s->{' outloc'} + 2, 0);
Packit 5d935b
            $fh->print(pack("n", $loc - $s->{' outloc'}));
Packit 5d935b
        } else
Packit 5d935b
        {
Packit 5d935b
            $fh->seek($s->{' outloc'} + 4, 0);
Packit 5d935b
            $fh->print(pack("N", $loc - $s->{' outloc'}));
Packit 5d935b
        }
Packit 5d935b
        $fh->seek($base_loc + 8 + ($i << 3), 0);
Packit 5d935b
        $fh->print(pack("N", $s->{' outloc'} - $base_loc));
Packit 5d935b
        $fh->seek($loc, 0);
Packit 5d935b
    }
Packit 5d935b
    $self;
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
Packit 5d935b
=head2 $t->XML_element($context, $depth, $name, $val)
Packit 5d935b
Packit 5d935b
Outputs the elements of the cmap in XML. We only need to process val here
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub XML_element
Packit 5d935b
{
Packit 5d935b
    my ($self, $context, $depth, $k, $val) = @_;
Packit 5d935b
    my ($fh) = $context->{'fh'};
Packit 5d935b
    my ($i);
Packit 5d935b
Packit 5d935b
    return $self if ($k eq 'LOC');
Packit 5d935b
    return $self->SUPER::XML_element($context, $depth, $k, $val) unless ($k eq 'val');
Packit 5d935b
Packit 5d935b
    $fh->print("$depth<mappings>\n");
Packit 5d935b
    foreach $i (sort {$a <=> $b} keys %{$val})
Packit 5d935b
    { $fh->printf("%s<map code='%04X' glyph='%s'/>\n", $depth . $context->{'indent'}, $i, $val->{$i}); }
Packit 5d935b
    $fh->print("$depth</mappings>\n");
Packit 5d935b
    $self;
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
Packit 5d935b
=head2 $t->minsize()
Packit 5d935b
Packit 5d935b
Returns the minimum size this table can be in bytes. If it is smaller than this, then the table
Packit 5d935b
must be bad and should be deleted or whatever.
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub minsize
Packit 5d935b
{
Packit 5d935b
    return 4;
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
Packit 5d935b
=head2 $t->update
Packit 5d935b
Packit 5d935b
Tidies the cmap table.
Packit 5d935b
Packit 5d935b
Removes MS Fmt12 cmap if it is no longer needed.
Packit 5d935b
Packit 5d935b
Removes from all cmaps any codepoint that map to GID=0. Note that such entries will
Packit 5d935b
be re-introduced as necessary depending on the cmap format.
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub update
Packit 5d935b
{
Packit 5d935b
    my ($self) = @_;
Packit 5d935b
    my ($max, $code, $gid, @keep);
Packit 5d935b
    
Packit 5d935b
    return undef unless ($self->SUPER::update);
Packit 5d935b
Packit 5d935b
    foreach my $s (@{$self->{'Tables'}})
Packit 5d935b
    {
Packit 5d935b
        $max = 0;
Packit 5d935b
        while (($code, $gid) = each %{$s->{'val'}})
Packit 5d935b
        {
Packit 5d935b
            if ($gid)
Packit 5d935b
            {
Packit 5d935b
                # remember max USV
Packit 5d935b
                $max = $code if $max < $code;
Packit 5d935b
            }
Packit 5d935b
            else
Packit 5d935b
            {
Packit 5d935b
                # Remove unneeded key
Packit 5d935b
                delete $s->{'val'}{$code};  # nb: this is a safe delete according to perldoc perlfunc.
Packit 5d935b
            }
Packit 5d935b
        }
Packit 5d935b
        push @keep, $s unless $s->{'Platform'} == 3 && $s->{'Encoding'} == 10 && $s->{'Format'} == 12 && $max <= 0xFFFF;
Packit 5d935b
    }
Packit 5d935b
    
Packit 5d935b
    $self->{'Tables'} = [ @keep ];  
Packit 5d935b
    
Packit 5d935b
    delete $self->{' mstable'};     # Force rediscovery of this.
Packit 5d935b
    
Packit 5d935b
    $self;
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
=head2 @map = $t->reverse(%opt)
Packit 5d935b
Packit 5d935b
Returns a reverse map of the Unicode cmap. I.e. given a glyph gives the Unicode value for it. Options are:
Packit 5d935b
Packit 5d935b
=over 4
Packit 5d935b
Packit 5d935b
=item tnum
Packit 5d935b
Packit 5d935b
Table number to use rather than the default Unicode table
Packit 5d935b
Packit 5d935b
=item array
Packit 5d935b
Packit 5d935b
Returns each element of reverse as an array since a glyph may be mapped by more
Packit 5d935b
than one Unicode value. The arrays are unsorted. Otherwise store any one unicode value for a glyph.
Packit 5d935b
Packit 5d935b
=back
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub reverse
Packit 5d935b
{
Packit 5d935b
    my ($self, %opt) = @_;
Packit 5d935b
    my ($table) = defined $opt{'tnum'} ? $self->{'Tables'}[$opt{'tnum'}] : $self->find_ms;
Packit 5d935b
    my (@res, $code, $gid);
Packit 5d935b
Packit 5d935b
    while (($code, $gid) = each(%{$table->{'val'}}))
Packit 5d935b
    {
Packit 5d935b
        if ($opt{'array'})
Packit 5d935b
        { push (@{$res[$gid]}, $code); }
Packit 5d935b
        else
Packit 5d935b
        { $res[$gid] = $code unless (defined $res[$gid] && $res[$gid] > 0 && $res[$gid] < $code); }
Packit 5d935b
    }
Packit 5d935b
    @res;
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
Packit 5d935b
=head2 is_unicode($index)
Packit 5d935b
Packit 5d935b
Returns whether the table of a given index is known to be a unicode table
Packit 5d935b
(as specified in the specifications)
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub is_unicode
Packit 5d935b
{
Packit 5d935b
    my ($self, $index) = @_;
Packit 5d935b
    my ($pid, $eid) = ($self->{'Tables'}[$index]{'Platform'}, $self->{'Tables'}[$index]{'Encoding'});
Packit 5d935b
Packit 5d935b
    return ($pid == 3 || $pid == 0 || ($pid == 2 && $eid == 1));
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
1;
Packit 5d935b
Packit 5d935b
=head1 BUGS
Packit 5d935b
Packit 5d935b
=over 4
Packit 5d935b
Packit 5d935b
=item *
Packit 5d935b
Packit 5d935b
Format 14 (Unicode Variation Sequences) cmaps are not supported.
Packit 5d935b
Packit 5d935b
=back
Packit 5d935b
Packit 5d935b
=head1 AUTHOR
Packit 5d935b
Packit 5d935b
Martin Hosken L<http://scripts.sil.org/FontUtils>. 
Packit 5d935b
Packit 5d935b
Packit 5d935b
=head1 LICENSING
Packit 5d935b
Packit 5d935b
Copyright (c) 1998-2016, SIL International (http://www.sil.org) 
Packit 5d935b
Packit 5d935b
This module is released under the terms of the Artistic License 2.0. 
Packit 5d935b
For details, see the full text of the license in the file LICENSE.
Packit 5d935b
Packit 5d935b
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b