<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Font::TTF::OldCmap;

=head1 NAME

Font::TTF::OldCmap - Character map table

This module is deprecated

=head1 DESCRIPTION

Looks after the character map. The primary structure used for handling a cmap
is the L&lt;Font::TTF::Segarr&gt; which handles the segmented arrays of format 4 tables,
and in a simpler form for format 0 tables.

Due to the complexity of working with segmented arrays, most of the handling of
such arrays is via methods rather than via instance variables.

One important feature of a format 4 table is that it always contains a segment
with a final address of 0xFFFF. If you are creating a table from scratch this is
important (although L&lt;Font::TTF::Segarr&gt; can work quite happily without it).


=head1 INSTANCE VARIABLES

The instance variables listed here are not preceeded by a space due to their
emulating structural information in the font.

=over 4

=item Num

Number of subtables in this table

=item Tables

An array of subtables ([0..Num-1])

=back

Each subtables also has its own instance variables which are, again, not
preceeded by a space.

=over 4

=item Platform

The platform number for this subtable

=item Encoding

The encoding number for this subtable

=item Format

Gives the stored format of this subtable

=item Ver

Gives the version (or language) information for this subtable

=item val

This points to a L&lt;Font::TTF::Segarr&gt; which contains the content of the particular
subtable.

=back

=head1 METHODS

=cut

use strict;
use vars qw(@ISA);
require Font::TTF::Table;
require Font::TTF::Segarr;

@ISA = qw(Font::TTF::Table);


=head2 $t-&gt;read

Reads the cmap into memory. Format 4 subtables read the whole subtable and
fill in the segmented array accordingly.

Format 2 subtables are not read at all.

=cut

sub read
{
    my ($self) = @_;
    my ($dat, $i, $j, $k, $id, @ids, $s);
    my ($start, $end, $range, $delta, $form, $len, $num, $ver);
    my ($fh) = $self-&gt;{' INFILE'};

    $self-&gt;SUPER::read or return $self;
    $fh-&gt;read($dat, 4);
    $self-&gt;{'Num'} = unpack("x2n", $dat);
    $self-&gt;{'Tables'} = [];
    for ($i = 0; $i &lt; $self-&gt;{'Num'}; $i++)
    {
        $s = {};
        $fh-&gt;read($dat, 8);
        ($s-&gt;{'Platform'}, $s-&gt;{'Encoding'}, $s-&gt;{'LOC'}) = (unpack("nnN", $dat));
        $s-&gt;{'LOC'} += $self-&gt;{' OFFSET'};
        push(@{$self-&gt;{'Tables'}}, $s);
    }
    for ($i = 0; $i &lt; $self-&gt;{'Num'}; $i++)
    {
        $s = $self-&gt;{'Tables'}[$i];
        $fh-&gt;seek($s-&gt;{'LOC'}, 0);
        $fh-&gt;read($dat, 6);
        ($form, $len, $ver) = (unpack("n3", $dat));

        $s-&gt;{'Format'} = $form;
        $s-&gt;{'Ver'} = $ver;
        if ($form == 0)
        {
            $s-&gt;{'val'} = Font::TTF::Segarr-&gt;new;
            $fh-&gt;read($dat, 256);
            $s-&gt;{'val'}-&gt;fastadd_segment(0, 2, unpack("C*", $dat));
            $s-&gt;{'Start'} = 0;
            $s-&gt;{'Num'} = 256;
        } elsif ($form == 6)
        {
            my ($start, $ecount);
            
            $fh-&gt;read($dat, 4);
            ($start, $ecount) = unpack("n2", $dat);
            $fh-&gt;read($dat, $ecount &lt;&lt; 1);
            $s-&gt;{'val'} = Font::TTF::Segarr-&gt;new;
            $s-&gt;{'val'}-&gt;fastadd_segment($start, 2, unpack("n*", $dat));
            $s-&gt;{'Start'} = $start;
            $s-&gt;{'Num'} = $ecount;
        } elsif ($form == 2)
        {
# no idea what to do here yet
        } elsif ($form == 4)
        {
            $fh-&gt;read($dat, 8);
            $num = unpack("n", $dat);
            $num &gt;&gt;= 1;
            $fh-&gt;read($dat, $len - 14);
            $s-&gt;{'val'} = Font::TTF::Segarr-&gt;new;
            for ($j = 0; $j &lt; $num; $j++)
            {
                $end = unpack("n", substr($dat, $j &lt;&lt; 1, 2));
                $start = unpack("n", substr($dat, ($j &lt;&lt; 1) + ($num &lt;&lt; 1) + 2, 2));
                $delta = unpack("n", substr($dat, ($j &lt;&lt; 1) + ($num &lt;&lt; 2) + 2, 2));
                $delta -= 65536 if $delta &gt; 32767;
                $range = unpack("n", substr($dat, ($j &lt;&lt; 1) + $num * 6 + 2, 2));
                @ids = ();
                for ($k = $start; $k &lt;= $end; $k++)
                {
                    if ($range == 0)
                    { $id = $k + $delta; }
                    else
                    { $id = unpack("n", substr($dat, ($j &lt;&lt; 1) + $num * 6 +
                                        2 + ($k - $start) * 2 + $range, 2)) + $delta; }
		            $id -= 65536 if $id &gt; 65536;
                    push (@ids, $id);
                }
                $s-&gt;{'val'}-&gt;fastadd_segment($start, 0, @ids);
            }
            $s-&gt;{'val'}-&gt;tidy;
            $s-&gt;{'Num'} = 0x10000;               # always ends here
            $s-&gt;{'Start'} = $s-&gt;{'val'}[0]{'START'};
        }
    }
    $self;
}


=head2 $t-&gt;ms_lookup($uni)

Given a Unicode value in the MS table (Platform 3, Encoding 1) locates that
table and looks up the appropriate glyph number from it.

=cut

sub ms_lookup
{
    my ($self, $uni) = @_;

    $self-&gt;find_ms || return undef unless (defined $self-&gt;{' mstable'});
    return $self-&gt;{' mstable'}{'val'}-&gt;at($uni);
}


=head2 $t-&gt;find_ms

Finds the Microsoft Unicode table and sets the C&lt;mstable&gt; instance variable
to it if found. Returns the table it finds.

=cut
sub find_ms
{
    my ($self) = @_;
    my ($i, $s, $alt);

    return $self-&gt;{' mstable'} if defined $self-&gt;{' mstable'};
    $self-&gt;read;
    for ($i = 0; $i &lt; $self-&gt;{'Num'}; $i++)
    {
        $s = $self-&gt;{'Tables'}[$i];
        if ($s-&gt;{'Platform'} == 3)
        {
            $self-&gt;{' mstable'} = $s;
            last if ($s-&gt;{'Encoding'} == 1);
        } elsif ($s-&gt;{'Platform'} == 0 || ($s-&gt;{'Platform'} == 2 &amp;&amp; $s-&gt;{'Encoding'} == 1))
        { $self-&gt;{' mstable'} = $s; }
    }
    $self-&gt;{' mstable'};
}


=head2 $t-&gt;out($fh)

Writes out a cmap table to a filehandle. If it has not been read, then
just copies from input file to output

=cut

sub out
{
    my ($self, $fh) = @_;
    my ($loc, $s, $i, $base_loc, $j);

    return $self-&gt;SUPER::out($fh) unless $self-&gt;{' read'};

    $base_loc = $fh-&gt;tell();
    $fh-&gt;print(pack("n2", 0, $self-&gt;{'Num'}));

    for ($i = 0; $i &lt; $self-&gt;{'Num'}; $i++)
    { $fh-&gt;print(pack("nnN", $self-&gt;{'Tables'}[$i]{'Platform'}, $self-&gt;{'Tables'}[$i]{'Encoding'}, 0)); }
    
    for ($i = 0; $i &lt; $self-&gt;{'Num'}; $i++)
    {
        $s = $self-&gt;{'Tables'}[$i];
        $s-&gt;{'val'}-&gt;tidy;
        $s-&gt;{' outloc'} = $fh-&gt;tell();
        $fh-&gt;print(pack("n3", $s-&gt;{'Format'}, 0, $s-&gt;{'Ver'}));       # come back for length
        if ($s-&gt;{'Format'} == 0)
        {
            $fh-&gt;print(pack("C256", $s-&gt;{'val'}-&gt;at(0, 256)));
        } elsif ($s-&gt;{'Format'} == 6)
        {
            $fh-&gt;print(pack("n2", $s-&gt;{'Start'}, $s-&gt;{'Num'}));
            $fh-&gt;print(pack("n*", $s-&gt;{'val'}-&gt;at($s-&gt;{'Start'}, $s-&gt;{'Num'})));
        } elsif ($s-&gt;{'Format'} == 2)
        {
        } elsif ($s-&gt;{'Format'} == 4)
        {
            my ($num, $sRange, $eSel);
            my (@deltas, $delta, @range, $flat, $k, $segs, $count);

            $num = $#{$s-&gt;{'val'}} + 1;
            $segs = $s-&gt;{'val'};
            for ($sRange = 1, $eSel = 0; $sRange &lt;= $num; $eSel++)
            { $sRange &lt;&lt;= 1;}
            $eSel--;
            $fh-&gt;print(pack("n4", $num * 2, $sRange, $eSel, ($num * 2) - $sRange));
            $fh-&gt;print(pack("n*", map {$_-&gt;{'START'} + $_-&gt;{'LEN'} - 1} @$segs));
            $fh-&gt;print(pack("n", 0));
            $fh-&gt;print(pack("n*", map {$_-&gt;{'START'}} @$segs));

            for ($j = 0; $j &lt; $num; $j++)
            {
                $delta = $segs-&gt;[$j]{'VAL'}[0]; $flat = 1;
                for ($k = 1; $k &lt; $segs-&gt;[$j]{'LEN'}; $k++)
                {
                    if ($segs-&gt;[$j]{'VAL'}[$k] == 0)
                    { $flat = 0; }
                    if ($delta + $k != $segs-&gt;[$j]{'VAL'}[$k])
                    {
                        $delta = 0;
                        last;
                    }
                }
                push (@range, $flat);
                push (@deltas, ($delta ? $delta - $segs-&gt;[$j]{'START'} : 0));
            }
            $fh-&gt;print(pack("n*", @deltas));

            $count = 0;
            for ($j = 0; $j &lt; $num; $j++)
            {
                $delta = $deltas[$j];
                if ($delta != 0 &amp;&amp; $range[$j] == 1)
                { $range[$j] = 0; }
                else
                {
                    $range[$j] = ($count + $num - $j) &lt;&lt; 1;
                    $count += $segs-&gt;[$j]{'LEN'};
                }
            }

            $fh-&gt;print(pack("n*", @range));

            for ($j = 0; $j &lt; $num; $j++)
            {
                next if ($range[$j] == 0);
                for ($k = 0; $k &lt; $segs-&gt;[$j]{'LEN'}; $k++)
                { $fh-&gt;print(pack("n", $segs-&gt;[$j]{'VAL'}[$k])); }
            }
        }

        $loc = $fh-&gt;tell();
        $fh-&gt;seek($s-&gt;{' outloc'} + 2, 0);
        $fh-&gt;print(pack("n", $loc - $s-&gt;{' outloc'}));
        $fh-&gt;seek($base_loc + 8 + ($i &lt;&lt; 3), 0);
        $fh-&gt;print(pack("N", $s-&gt;{' outloc'} - $base_loc));
        $fh-&gt;seek($loc, 0);
    }
    $self;
}


=head2 @map = $t-&gt;reverse([$num])

Returns a reverse map of the table of given number or the Microsoft
cmap. I.e. given a glyph gives the Unicode value for it.

=cut

sub reverse
{
    my ($self, $tnum) = @_;
    my ($table) = defined $tnum ? $self-&gt;{'Tables'}[$tnum] : $self-&gt;find_ms;
    my (@res, $i, $s, $first);

    foreach $s (@{$table-&gt;{'val'}})
    {
        $first = $s-&gt;{'START'};
        map {$res[$_] = $first unless $res[$_]; $first++;} @{$s-&gt;{'VAL'}};
    }
    @res;
}

1;

=head1 BUGS

=over 4

=item *

No support for format 2 tables (MBCS)

=back

=head1 AUTHOR

Martin Hosken Martin_Hosken@sil.org. See L&lt;Font::TTF::Font&gt; for copyright and
licensing.

=cut

</pre></body></html>