1#=======================================================================
2#    ____  ____  _____              _    ____ ___   ____
3#   |  _ \|  _ \|  ___|  _   _     / \  |  _ \_ _| |___ \
4#   | |_) | | | | |_    (_) (_)   / _ \ | |_) | |    __) |
5#   |  __/| |_| |  _|    _   _   / ___ \|  __/| |   / __/
6#   |_|   |____/|_|     (_) (_) /_/   \_\_|  |___| |_____|
7#
8#   A Perl Module Chain to faciliate the Creation and Modification
9#   of High-Quality "Portable Document Format (PDF)" Files.
10#
11#=======================================================================
12#
13#   THIS IS A REUSED PERL MODULE, FOR PROPER LICENCING TERMS SEE BELOW:
14#
15#
16#   Copyright Martin Hosken <Martin_Hosken@sil.org>
17#
18#   No warranty or expression of effectiveness, least of all regarding
19#   anyone's safety, is implied in this software or documentation.
20#
21#   This specific module is licensed under the Perl Artistic License.
22#
23#
24#   $Id: Delta.pm,v 2.0 2005/11/16 02:16:00 areibens Exp $
25#
26#=======================================================================
27package PDF::API3::Compat::API2::Basic::TTF::Delta;
28
29=head1 TITLE
30
31SIL::TTF::Delta - Opentype Device tables
32
33=head1 DESCRIPTION
34
35Each device table corresponds to a set of deltas for a particular point over
36a range of ppem values.
37
38=item first
39
40The first ppem value in the range
41
42=item last
43
44The last ppem value in the range
45
46=item val
47
48This is an array of deltas corresponding to each ppem in the range between
49first and last inclusive.
50
51=item fmt
52
53This is the fmt used (log2 of number bits per value) when the device table was
54read. It is recalculated on output.
55
56=head1 METHODS
57
58=cut
59
60use strict;
61use PDF::API3::Compat::API2::Basic::TTF::Utils;
62
63=head2 new
64
65Creates a new device table
66
67=cut
68
69sub new
70{
71    my ($class) = @_;
72    my ($self) = {};
73
74    bless $self, $class;
75}
76
77
78=head2 read
79
80Reads a device table from the given IO object at the current location
81
82=cut
83
84sub read
85{
86    my ($self, $fh) = @_;
87    my ($dat, $fmt, $num, $i, $j, $mask);
88
89    $fh->read($dat, 6);
90    ($self->{'first'}, $self->{'last'}, $fmt) = TTF_Unpack("S3", $dat);
91    $self->{'fmt'} = $fmt;
92
93    $fmt = 1 << $fmt;
94    $num = ((($self->{'last'} - $self->{'first'} + 1) * $fmt) + 15) >> 8;
95    $fh->read($dat, $num);
96
97    $mask = (0xffff << (16 - $fmt)) & 0xffff;
98    $j = 0;
99    for ($i = $self->{'first'}; $i <= $self->{'last'}; $i++)
100    {
101        if ($j == 0)
102        {
103            $num = TTF_Unpack("S", substr($dat, 0, 2));
104            substr($dat, 0, 2) = '';
105        }
106        push (@{$self->{'val'}}, ($num & $mask) >> (16 - $fmt));
107        $num <<= $fmt;
108        $j += $fmt;
109        $j = 0 if ($j >= 16);
110    }
111    $self;
112}
113
114
115=head2 out($fh, $style)
116
117Outputs a device table to the given IO object at the current location, or just
118returns the data to be output if $style != 0
119
120=cut
121
122sub out
123{
124    my ($self, $fh, $style) = @_;
125    my ($dat, $fmt, $num, $mask, $j, $f, $out);
126
127    foreach $f (@{$self->{'val'}})
128    {
129        my ($tfmt) = $f > 0 ? $f + 1 : -$f;
130        $fmt = $tfmt if $tfmt > $fmt;
131    }
132
133    if ($fmt > 8)
134    { $fmt = 3; }
135    elsif ($fmt > 2)
136    { $fmt = 2; }
137    else
138    { $fmt = 1; }
139
140    $out = TTF_Pack("S3", $self->{'first'}, $self->{'last'}, $fmt);
141
142    $fmt = 1 << $fmt;
143    $mask = 0xffff >> (16 - $fmt);
144    $j = 0; $dat = 0;
145    foreach $f (@{$self->{'val'}})
146    {
147        $dat |= ($f & $mask) << (16 - $fmt - $j);
148        $j += $fmt;
149        if ($j >= 16)
150        {
151            $j = 0;
152            $out .= TTF_Pack("S", $dat);
153            $dat = 0;
154        }
155    }
156    $out .= pack('n', $dat) if ($j > 0);
157    $fh->print($out) unless $style;
158    $out;
159}
160
161
162=head2 $d->out_xml($context)
163
164Outputs a delta in XML
165
166=cut
167
168sub out_xml
169{
170    my ($self, $context, $depth) = @_;
171    my ($fh) = $context->{'fh'};
172
173    $fh->printf("%s<delta first='%s' last='%s'>\n", $depth, $self->{'first'}, $self->{'last'});
174    $fh->print("$depth$context->{'indent'}" . join (' ', @{$self->{'val'}}) . "\n") if defined ($self->{'val'});
175    $fh->print("$depth</delta>\n");
176}
177
178=head1 AUTHOR
179
180Martin Hosken Martin_Hosken@sil.org. See L<PDF::API3::Compat::API2::Basic::TTF::Font> for copyright and
181licensing.
182
183=cut
184
1851;
186
187