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#   Copyright 1999-2005 Alfred Reibenschuh <areibens@cpan.org>.
12#
13#=======================================================================
14#
15#   THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR
16#   MODIFY IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC
17#   LICENSE AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; EITHER
18#   VERSION 2 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
19#
20#   THIS FILE IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL,
21#   AND ANY EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22#   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
23#   FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT
24#   SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR CONTRIBUTORS
25#   BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
26#   EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
27#   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
28#   OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29#   CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
30#   STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
31#   ARISING IN ANY WAY OUT OF THE USE OF THIS FILE, EVEN IF
32#   ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
33#
34#   SEE THE GNU LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
35#
36#   YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC
37#   LICENSE ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE
38#   FREE SOFTWARE FOUNDATION, INC., 59 TEMPLE PLACE - SUITE 330,
39#   BOSTON, MA 02111-1307, USA.
40#
41#   $Id: neTrueType.pm,v 1.2 2008/01/04 08:10:42 areibens Exp $
42#
43#=======================================================================
44package PDF::API3::Compat::API2::Resource::Font::neTrueType;
45
46=head1 NAME
47
48PDF::API3::Compat::API2::Resource::Font::neTrueType - Module for using 8bit nonembedded truetype Fonts.
49
50=head1 SYNOPSIS
51
52    #
53    use PDF::API3::Compat::API2;
54    #
55    $pdf = PDF::API3::Compat::API2->new;
56    $cft = $pdf->nettfont('Times-Roman.ttf', -encode => 'latin1');
57    #
58
59=head1 METHODS
60
61=over 4
62
63=cut
64
65BEGIN {
66
67    use utf8;
68    use Encode qw(:all);
69
70    use File::Basename;
71
72    use vars qw( @ISA $fonts $alias $subs $encodings $VERSION );
73    use PDF::API3::Compat::API2::Resource::Font;
74    use PDF::API3::Compat::API2::Util;
75    use PDF::API3::Compat::API2::Basic::PDF::Utils;
76
77    @ISA=qw(PDF::API3::Compat::API2::Resource::Font);
78
79    ( $VERSION ) = sprintf '%i.%03i', split(/\./,('$Revision: 1.2 $' =~ /Revision: (\S+)\s/)[0]); # $Date: 2008/01/04 08:10:42 $
80
81}
82no warnings qw[ deprecated recursion uninitialized ];
83
84=item $font = PDF::API3::Compat::API2::Resource::Font::neTrueType->new $pdf, $fontfile, %options
85
86Returns a corefont object.
87
88=cut
89
90=pod
91
92Valid %options are:
93
94I<-encode>
95... changes the encoding of the font from its default.
96See I<perl's Encode> for the supported values.
97
98I<-pdfname> ... changes the reference-name of the font from its default.
99The reference-name is normally generated automatically and can be
100retrived via $pdfname=$font->name.
101
102=cut
103
104sub unpack_fixed
105{
106    my ($dat) = @_;
107    my ($res, $frac) = unpack("nn", $dat);
108    $res -= 65536 if $res > 32767;
109    $res += $frac / 65536.;
110    return($res);
111}
112
113sub unpack_f2dot14
114{
115    my ($dat) = @_;
116    my $res = unpack("n", $dat);
117    my $frac = $res & 0x3fff;
118    $res >>= 14;
119    $res -= 4 if $res > 1;
120    $res += $frac / 16384.;
121    return($res);
122}
123
124sub unpack_long
125{
126    my ($dat) = @_;
127    my $res = unpack("N", $dat);
128    $res -= (1 << 32) if ($res >= 1 << 31);
129    return($res);
130}
131
132sub unpack_ulong
133{
134    my ($dat) = @_;
135    my $res = unpack("N", $dat);
136    return($res);
137}
138
139sub unpack_short
140{
141    my ($dat) = @_;
142    my $res = unpack("n", $dat);
143    $res -= 65536 if ($res >= 32768);
144    return($res);
145}
146
147sub unpack_ushort
148{
149    my ($dat) = @_;
150    my $res = unpack("n", $dat);
151    return($res);
152}
153
154sub read_name_table
155{
156    my ($data, $fh, $num, $stroff, $buf) = @_;
157    # read name table
158    seek($fh,$data->{name}->{OFF},0);
159
160    read($fh,$buf, 6);
161
162    ($num, $stroff) = unpack("x2nn", $buf);
163
164    $data->{name}->{ARR}=[];
165
166    for (my $i = 0; $i < $num; $i++)
167    {
168        read($fh,$buf, 12);
169        my ($pid, $eid, $lid, $nid, $len, $off) = unpack("n6", $buf);
170        push @{$data->{name}->{ARR}},[$pid, $eid, $lid, $nid, $len, $off];
171    }
172
173    foreach my $arr ( @{$data->{name}->{ARR}} ) {
174        my ($pid, $eid, $lid, $nid, $len, $off) = @{$arr};
175        seek($fh,$data->{name}->{OFF} + $stroff + $off, 0);
176        read($fh, $buf, $len);
177
178        if ($pid == 0 || $pid == 3 || ($pid == 2 && $eid == 1))
179            { $buf = pack('C*',map { $_>255 ? 20 : $_ } unpack('n*',$buf)); }
180
181        $data->{name}->{strings}[$nid][$pid][$eid]{$lid} = $buf;
182    }
183}
184
185sub read_os2_table
186{
187    my ($data, $fh, $buf) = @_;
188
189    # read OS/2 table
190    seek($fh,$data->{'OS/2'}->{OFF},0);
191    read($fh,$buf, 2);
192    my $os2ver=unpack_ushort($buf);
193
194    seek($fh,$data->{'OS/2'}->{OFF}+4,0);
195    read($fh,$buf, 4);
196    ($data->{V}->{usWeightClass},$data->{V}->{usWidthClass})=unpack('nn',$buf);
197
198    seek($fh,$data->{'OS/2'}->{OFF}+30,0);
199    read($fh,$buf, 12);
200    $data->{V}->{panoseHex}=unpack('H*',$buf);
201    $data->{V}->{panose}=$buf;
202	($data->{V}->{sFamilyClass}, $data->{V}->{bFamilyType}, $data->{V}->{bSerifStyle}, $data->{V}->{bWeight},
203		$data->{V}->{bProportion}, $data->{V}->{bContrast}, $data->{V}->{bStrokeVariation}, $data->{V}->{bArmStyle},
204		$data->{V}->{bLetterform}, $data->{V}->{bMidline}, $data->{V}->{bXheight}) = unpack('nC*',$buf);
205
206	$data->{V}->{flags} = 0;
207    $data->{V}->{flags} |= 1 if ($data->{V}->{'bProportion'} == 9);
208    $data->{V}->{flags} |= 2 unless ($data->{V}->{'bSerifStyle'} > 10 && $data->{V}->{'bSerifStyle'} < 14);
209    $data->{V}->{flags} |= 8 if ($data->{V}->{'bFamilyType'} == 2);
210    $data->{V}->{flags} |= 32; # if ($data->{V}->{'bFamilyType'} > 3);
211    $data->{V}->{flags} |= 64 if ($data->{V}->{'bLetterform'} > 8);
212
213    seek($fh,$data->{'OS/2'}->{OFF}+42,0);
214    read($fh,$buf, 16);
215    $data->{V}->{ulUnicodeRange}=[ unpack('NNNN',$buf) ];
216    my @ulCodePageRange=();
217
218    if($os2ver>0) {
219        seek($fh,$data->{'OS/2'}->{OFF}+78,0);
220        read($fh,$buf, 8);
221        $data->{V}->{ulCodePageRange}=[ unpack('NN',$buf) ];
222        read($fh,$buf, 4);
223        ($data->{V}->{xHeight},$data->{V}->{CapHeight})=unpack('nn',$buf);
224    }
225}
226
227sub read_head_table
228{
229    my ($data, $fh, $buf) = @_;
230
231    seek($fh,$data->{'head'}->{OFF}+18,0);
232    read($fh,$buf, 2);
233    $data->{V}->{upem}=unpack_ushort($buf);
234    $data->{V}->{upemf}=1000/$data->{V}->{upem};
235
236    seek($fh,$data->{'head'}->{OFF}+36,0);
237    read($fh,$buf, 2);
238    $data->{V}->{xMin}=unpack_short($buf);
239    read($fh,$buf, 2);
240    $data->{V}->{yMin}=unpack_short($buf);
241    read($fh,$buf, 2);
242    $data->{V}->{xMax}=unpack_short($buf);
243    read($fh,$buf, 2);
244    $data->{V}->{yMax}=unpack_short($buf);
245
246    $data->{V}->{fontbbox}=[
247        int($data->{V}->{'xMin'} * $data->{V}->{upemf}),
248        int($data->{V}->{'yMin'} * $data->{V}->{upemf}),
249        int($data->{V}->{'xMax'} * $data->{V}->{upemf}),
250        int($data->{V}->{'yMax'} * $data->{V}->{upemf})
251    ];
252    seek($fh,$data->{'head'}->{OFF}+50,0);
253    read($fh,$data->{'head'}->{indexToLocFormat}, 2);
254    $data->{'head'}->{indexToLocFormat}=unpack_ushort($data->{'head'}->{indexToLocFormat});
255}
256
257sub read_maxp_table
258{
259    my ($data, $fh, $buf) = @_;
260
261    seek($fh,$data->{'maxp'}->{OFF}+4,0);
262    read($fh,$buf, 2);
263    $data->{V}->{numGlyphs}=unpack_ushort($buf);
264    $data->{maxp}->{numGlyphs}=$data->{V}->{numGlyphs};
265}
266
267sub read_hhea_table
268{
269    my ($data, $fh, $buf) = @_;
270
271    seek($fh,$data->{'hhea'}->{OFF}+4,0);
272    read($fh,$buf, 2);
273    $data->{V}->{ascender}=unpack_short($buf);
274
275    read($fh,$buf, 2);
276    $data->{V}->{descender}=unpack_short($buf);
277
278    read($fh,$buf, 2);
279    $data->{V}->{linegap}=unpack_short($buf);
280
281    read($fh,$buf, 2);
282    $data->{V}->{advancewidthmax}=unpack_short($buf);
283
284    seek($fh,$data->{'hhea'}->{OFF}+34,0);
285    read($fh,$buf, 2);
286    $data->{V}->{numberOfHMetrics}=unpack_ushort($buf);
287}
288
289sub read_hmtx_table
290{
291    my ($data, $fh, $buf) = @_;
292
293    seek($fh,$data->{'hmtx'}->{OFF},0);
294    $data->{hmtx}->{wx}=[];
295
296    foreach (1..$data->{V}->{numberOfHMetrics})
297    {
298        read($fh,$buf, 2);
299        my $wx=int(unpack_ushort($buf)*1000/$data->{V}->{upem});
300        push @{$data->{hmtx}->{wx}},$wx;
301        read($fh,$buf, 2);
302    }
303    $data->{V}->{missingwidth}=$data->{hmtx}->{wx}->[-1];
304}
305
306sub read_cmap_table
307{
308    my ($data, $fh, $buf) = @_;
309    my $cmap=$data->{cmap};
310    seek($fh,$cmap->{OFF},0);
311
312    read($fh,$buf,4);
313    $cmap->{Num} = unpack("x2n", $buf);
314    $cmap->{Tables} = [];
315
316    foreach my $i (0..$cmap->{Num})
317    {
318        my $s = {};
319        read($fh,$buf,8);
320        ($s->{Platform}, $s->{Encoding}, $s->{LOC}) = (unpack("nnN", $buf));
321        $s->{LOC} += $cmap->{OFF};
322        push(@{$cmap->{Tables}}, $s);
323    }
324
325    foreach my $i (0..$cmap->{Num})
326    {
327        my $s = $cmap->{Tables}[$i];
328        seek($fh,$s->{LOC}, 0);
329        read($fh,$buf, 2);
330        $s->{Format} = unpack("n", $buf);
331
332        if ($s->{Format} == 0)
333        {
334            my $len;
335            $fh->read($buf, 4);
336            ($len, $s->{Ver}) = unpack('n2', $buf);
337            $s->{val}={};
338            foreach my $j (0..255)
339            {
340                read($fh,$buf, 1);
341                $s->{val}->{$j}=unpack('C',$buf);
342            }
343        }
344        elsif ($s->{Format} == 2)
345        {
346            # cjk euc ?
347        }
348        elsif ($s->{Format} == 4)
349        {
350            my ($len,$count);
351            $fh->read($buf, 12);
352            ($len, $s->{Ver},$count) = unpack('n3', $buf);
353            $count >>= 1;
354            $s->{val}={};
355            read($fh, $buf, $len - 14);
356            foreach my $j (0..$count-1)
357            {
358                my $end = unpack("n", substr($buf, $j << 1, 2));
359                my $start = unpack("n", substr($buf, ($j << 1) + ($count << 1) + 2, 2));
360                my $delta = unpack("n", substr($buf, ($j << 1) + ($count << 2) + 2, 2));
361                $delta -= 65536 if $delta > 32767;
362                my $range = unpack("n", substr($buf, ($j << 1) + $count * 6 + 2, 2));
363                foreach my $k ($start..$end)
364                {
365                    my $id=undef;
366
367                    if ($range == 0 || $range == 65535) # support the buggy FOG with its range=65535 for final segment
368                    {
369                        $id = $k + $delta;
370                    }
371                    else
372                    {
373                        $id = unpack("n",
374                            substr($buf, ($j << 1) + $count * 6 +
375                                2 + ($k - $start) * 2 + $range, 2)) + $delta;
376                    }
377
378                    $id -= 65536 if($id >= 65536);
379                    $s->{val}->{$k} = $id if($id);
380                }
381            }
382        }
383        elsif ($s->{Format} == 6)
384        {
385            my ($len,$start,$count);
386            $fh->read($buf, 8);
387            ($len, $s->{Ver},$start,$count) = unpack('n4', $buf);
388            $s->{val}={};
389            foreach my $j (0..$count-1)
390            {
391                read($fh,$buf, 2);
392                $s->{val}->{$start+$j}=unpack('n',$buf);
393            }
394        }
395        elsif ($s->{Format} == 10)
396        {
397            my ($len,$start,$count);
398            $fh->read($buf, 18);
399            ($len, $s->{Ver},$start,$count) = unpack('x2N4', $buf);
400            $s->{val}={};
401            foreach my $j (0..$count-1)
402            {
403                read($fh,$buf, 2);
404                $s->{val}->{$start+$j}=unpack('n',$buf);
405            }
406        }
407        elsif ($s->{Format} == 8 || $s->{Format} == 12)
408        {
409            my ($len,$count);
410            $fh->read($buf, 10);
411            ($len, $s->{Ver}) = unpack('x2N2', $buf);
412            $s->{val}={};
413            if($s->{Format} == 8)
414            {
415                read($fh, $buf, 8192);
416                read($fh, $buf, 4);
417            }
418            else
419            {
420                read($fh, $buf, 4);
421            }
422            $count = unpack('N', $buf);
423            foreach my $j (0..$count-1)
424            {
425                read($fh,$buf, 12);
426                my ($start,$end,$cid)=unpack('N3',$buf);
427                foreach my $k ($start..$end)
428                {
429                    $s->{val}->{$k}=$cid+$k-$start;
430                }
431            }
432        }
433    }
434
435    my $alt;
436    foreach my $s (@{$cmap->{Tables}})
437    {
438        if($s->{Platform} == 3)
439        {
440            $cmap->{mstable} = $s;
441            last if(($s->{Encoding} == 1) || ($s->{Encoding} == 0));
442        }
443        elsif($s->{Platform} == 0 || ($s->{Platform} == 2 && $s->{Encoding} == 1))
444        {
445            $alt = $s;
446        }
447    }
448    $cmap->{mstable}||=$alt if($alt);
449
450    $data->{V}->{uni}=[];
451    foreach my $i (keys %{$cmap->{mstable}->{val}})
452    {
453        $data->{V}->{uni}->[$cmap->{mstable}->{val}->{$i}]=$i;
454    }
455
456    foreach my $i (0..$data->{V}->{numGlyphs})
457    {
458        $data->{V}->{uni}->[$i]||=0;
459    }
460}
461
462sub read_post_table
463{
464    my ($data, $fh, $buf) = @_;
465    my $post=$data->{post};
466    seek($fh,$post->{OFF},0);
467
468    my @base_set=qw[
469        .notdef .null nonmarkingreturn space exclam quotedbl numbersign dollar
470        percent ampersand quotesingle parenleft parenright asterisk plus comma
471        hyphen period slash zero one two three four five six seven eight nine
472        colon semicolon less equal greater question at A B C D E F G H I J K L
473        M N O P Q R S T U V W X Y Z bracketleft backslash bracketright
474        asciicircum underscore grave a b c d e f g h i j k l m n o p q r s t u
475        v w x y z braceleft bar braceright asciitilde Adieresis Aring Ccedilla
476        Eacute Ntilde Odieresis Udieresis aacute agrave acircumflex adieresis
477        atilde aring ccedilla eacute egrave ecircumflex edieresis iacute
478        igrave icircumflex idieresis ntilde oacute ograve ocircumflex
479        odieresis otilde uacute ugrave ucircumflex udieresis dagger degree
480        cent sterling section bullet paragraph germandbls registered copyright
481        trademark acute dieresis notequal AE Oslash infinity plusminus
482        lessequal greaterequal yen mu partialdiff summation product pi
483        integral ordfeminine ordmasculine Omega ae oslash questiondown
484        exclamdown logicalnot radical florin approxequal Delta guillemotleft
485        guillemotright ellipsis nonbreakingspace Agrave Atilde Otilde OE oe
486        endash emdash quotedblleft quotedblright quoteleft quoteright divide
487        lozenge ydieresis Ydieresis fraction currency guilsinglleft
488        guilsinglright fi fl daggerdbl periodcentered quotesinglbase
489        quotedblbase perthousand Acircumflex Ecircumflex Aacute Edieresis
490        Egrave Iacute Icircumflex Idieresis Igrave Oacute Ocircumflex apple
491        Ograve Uacute Ucircumflex Ugrave dotlessi circumflex tilde macron breve
492        dotaccent ring cedilla hungarumlaut ogonek caron Lslash lslash Scaron
493        scaron Zcaron zcaron brokenbar Eth eth Yacute yacute Thorn thorn minus
494        multiply onesuperior twosuperior threesuperior onehalf onequarter
495        threequarters franc Gbreve gbreve Idotaccent Scedilla scedilla Cacute
496        cacute Ccaron ccaron dcroat
497    ];
498
499    read($fh,$buf, 4);
500    $post->{Format}=unpack('N',$buf);
501    read($fh,$buf,4);
502    $data->{V}->{italicangle}=unpack_fixed($buf);
503    read($fh,$buf,2);
504    $data->{V}->{underlineposition}=unpack_f2dot14($buf)*1000;
505    read($fh,$buf,2);
506    $data->{V}->{underlinethickness}=unpack_f2dot14($buf)*1000;
507    read($fh,$buf,4);
508    $data->{V}->{isfixedpitch}=unpack_ulong($buf);
509    read($fh,$buf,16);
510
511    if($post->{Format} == 0x00010000)
512    {
513        $post->{Format}='10';
514        $post->{val}=[ @base_set ];
515        $post->{strings}={};
516        foreach my $i (0..257)
517        {
518            $post->{strings}->{$post->{val}->[$i]}=$i;
519        }
520    }
521    elsif($post->{Format} == 0x00020000)
522    {
523        $post->{Format}='20';
524        $post->{val}=[];
525        $post->{strings}={};
526        read($fh,$buf,2);
527        $post->{numGlyphs}=unpack_ushort($buf);
528        foreach my $i (0..$post->{numGlyphs}-1)
529        {
530            read($fh,$buf,2);
531            $post->{val}->[$i]=unpack_ushort($buf);
532        }
533        while(tell($fh) < $post->{OFF}+$post->{LEN})
534        {
535            read($fh,$buf,1);
536            my $strlen=unpack('C',$buf);
537            read($fh,$buf,$strlen);
538            push(@base_set,$buf);
539        }
540        foreach my $i (0..$post->{numGlyphs}-1)
541        {
542            $post->{val}->[$i]=$base_set[$post->{val}->[$i]];
543            $post->{strings}->{$post->{val}->[$i]}||=$i;
544        }
545    }
546    elsif($post->{Format} == 0x00025000)
547    {
548        $post->{Format}='25';
549        $post->{val}=[];
550        $post->{strings}={};
551        read($fh,$buf,2);
552        my $num=unpack_ushort($buf);
553        foreach my $i (0..$num)
554        {
555            read($fh,$buf,1);
556            $post->{val}->[$i]=$base_set[$i+unpack('c',$buf)];
557            $post->{strings}->{$post->{val}->[$i]}||=$i;
558        }
559    }
560    elsif($post->{Format} == 0x00030000)
561    {
562        $post->{Format}='30';
563        $post->{val}=[];
564        $post->{strings}={};
565    }
566
567    $data->{V}->{name}=[];
568    foreach my $i (0..$data->{V}->{numGlyphs})
569    {
570        $data->{V}->{name}->[$i] = $post->{val}->[$i]
571            || nameByUni($data->{V}->{uni}->[$i])
572            || '.notdef';
573    }
574
575    $data->{V}->{n2i}={};
576    foreach my $i (0..$data->{V}->{numGlyphs})
577    {
578        $data->{V}->{n2i}->{$data->{V}->{name}->[$i]}||=$i;
579    }
580}
581
582sub read_loca_table
583{
584    my ($data, $fh, $buf) = @_;
585
586    seek($fh,$data->{'loca'}->{OFF},0);
587    my $ilen=$data->{'head'}->{indexToLocFormat} ? 4 : 2;
588    my $ipak=$data->{'head'}->{indexToLocFormat} ? 'N' : 'n';
589    my $isif=$data->{'head'}->{indexToLocFormat} ? 0 : 1;
590
591    $data->{'loca'}->{gOFF}=[];
592
593    for(my $i=0; $i<$data->{'maxp'}->{numGlyphs}+1; $i++)
594    {
595        read($fh, $buf, $ilen);
596        $buf=unpack($ipak,$buf);
597        $buf<<=$isif;
598        push @{$data->{'loca'}->{gOFF}},$buf;
599    }
600}
601
602sub read_glyf_table
603{
604    my ($data, $fh, $buf) = @_;
605
606    $data->{'glyf'}->{glyphs}=[];
607
608    for(my $i=0; $i<$data->{'maxp'}->{numGlyphs}; $i++)
609    {
610        my $G={};
611        $data->{'glyf'}->{glyphs}->[$i]=$G;
612        next if($data->{'loca'}->{gOFF}->[$i]-$data->{'loca'}->{gOFF}->[$i+1] == 0);
613        seek($fh,$data->{'loca'}->{gOFF}->[$i]+$data->{'glyf'}->{OFF},0);
614        read($fh, $buf, 2);
615        $G->{numOfContours}=unpack_short($buf);
616        read($fh, $buf, 2);
617        $G->{xMin}=unpack_short($buf);
618        read($fh, $buf, 2);
619        $G->{yMin}=unpack_short($buf);
620        read($fh, $buf, 2);
621        $G->{xMax}=unpack_short($buf);
622        read($fh, $buf, 2);
623        $G->{yMax}=unpack_short($buf);
624    }
625}
626
627sub find_name
628{
629    my ($self, $nid) = @_;
630    my ($res, $pid, $eid, $lid, $look, $k);
631
632    my (@lookup) = ([3, 1, 1033], [3, 1, -1], [2, 1, -1], [2, 2, -1], [2, 0, -1],
633                    [0, 0, 0], [1, 0, 0]);
634    foreach $look (@lookup)
635    {
636        ($pid, $eid, $lid) = @$look;
637        if ($lid == -1)
638        {
639            foreach $k (keys %{$self->{'strings'}->[$nid]->[$pid]->[$eid]})
640            {
641                if (($res = $self->{strings}->[$nid]->[$pid]->[$eid]->{$k}) ne '')
642                {
643                    $lid = $k;
644                    last;
645                }
646            }
647        } else
648        { $res = $self->{strings}->[$nid]->[$pid]->[$eid]->{$lid} }
649        if ($res ne '')
650        { return wantarray ? ($res, $pid, $eid, $lid) : $res; }
651    }
652    return '';
653}
654
655sub readcffindex
656{
657    my ($fh,$off,$buf)=@_;
658    my @idx=();
659    my $index=[];
660    seek($fh,$off,0);
661    read($fh,$buf,3);
662    my ($count,$offsize)=unpack('nC',$buf);
663    foreach (0..$count)
664    {
665        read($fh,$buf,$offsize);
666        $buf=substr("\x00\x00\x00$buf",-4,4);
667        my $id=unpack('N',$buf);
668        push @idx,$id;
669    }
670    my $dataoff=tell($fh)-1;
671
672    foreach my $i (0..$count-1)
673    {
674        push @{$index},{ 'OFF' => $dataoff+$idx[$i], 'LEN' => $idx[$i+1]-$idx[$i] };
675    }
676    return($index);
677}
678
679sub readcffdict
680{
681    my ($fh,$off,$len,$foff,$buf)=@_;
682    my @idx=();
683    my $dict={};
684    seek($fh,$off,0);
685    my @st=();
686    while(tell($fh)<($off+$len))
687    {
688        read($fh,$buf,1);
689        my $b0=unpack('C',$buf);
690        my $v='';
691
692        if($b0==12) # two byte commands
693        {
694            read($fh,$buf,1);
695            my $b1=unpack('C',$buf);
696            if($b1==0)
697            {
698                $dict->{Copyright}={ 'SID' => splice(@st,-1) };
699            }
700            elsif($b1==1)
701            {
702                $dict->{isFixedPitch}=splice(@st,-1);
703            }
704            elsif($b1==2)
705            {
706                $dict->{ItalicAngle}=splice(@st,-1);
707            }
708            elsif($b1==3)
709            {
710                $dict->{UnderlinePosition}=splice(@st,-1);
711            }
712            elsif($b1==4)
713            {
714                $dict->{UnderlineThickness}=splice(@st,-1);
715            }
716            elsif($b1==5)
717            {
718                $dict->{PaintType}=splice(@st,-1);
719            }
720            elsif($b1==6)
721            {
722                $dict->{CharstringType}=splice(@st,-1);
723            }
724            elsif($b1==7)
725            {
726                $dict->{FontMatrix}=[ splice(@st,-4) ];
727            }
728            elsif($b1==8)
729            {
730                $dict->{StrokeWidth}=splice(@st,-1);
731            }
732            elsif($b1==20)
733            {
734                $dict->{SyntheticBase}=splice(@st,-1);
735            }
736            elsif($b1==21)
737            {
738                $dict->{PostScript}={ 'SID' => splice(@st,-1) };
739            }
740            elsif($b1==22)
741            {
742                $dict->{BaseFontName}={ 'SID' => splice(@st,-1) };
743            }
744            elsif($b1==23)
745            {
746                $dict->{BaseFontBlend}=[ splice(@st,0) ];
747            }
748            elsif($b1==24)
749            {
750                $dict->{MultipleMaster}=[ splice(@st,0) ];
751            }
752            elsif($b1==25)
753            {
754                $dict->{BlendAxisTypes}=[ splice(@st,0) ];
755            }
756            elsif($b1==30)
757            {
758                $dict->{ROS}=[ splice(@st,-3) ];
759            }
760            elsif($b1==31)
761            {
762                $dict->{CIDFontVersion}=splice(@st,-1);
763            }
764            elsif($b1==32)
765            {
766                $dict->{CIDFontRevision}=splice(@st,-1);
767            }
768            elsif($b1==33)
769            {
770                $dict->{CIDFontType}=splice(@st,-1);
771            }
772            elsif($b1==34)
773            {
774                $dict->{CIDCount}=splice(@st,-1);
775            }
776            elsif($b1==35)
777            {
778                $dict->{UIDBase}=splice(@st,-1);
779            }
780            elsif($b1==36)
781            {
782                $dict->{FDArray}={ 'OFF' => $foff+splice(@st,-1) };
783            }
784            elsif($b1==37)
785            {
786                $dict->{FDSelect}={ 'OFF' => $foff+splice(@st,-1) };
787            }
788            elsif($b1==38)
789            {
790                $dict->{FontName}={ 'SID' => splice(@st,-1) };
791            }
792            elsif($b1==39)
793            {
794                $dict->{Chameleon}=splice(@st,-1);
795            }
796            next;
797        }
798        elsif($b0<28) # commands
799        {
800            if($b0==0)
801            {
802                $dict->{Version}={ 'SID' => splice(@st,-1) };
803            }
804            elsif($b0==1)
805            {
806                $dict->{Notice}={ 'SID' => splice(@st,-1) };
807            }
808            elsif($b0==2)
809            {
810                $dict->{FullName}={ 'SID' => splice(@st,-1) };
811            }
812            elsif($b0==3)
813            {
814                $dict->{FamilyName}={ 'SID' => splice(@st,-1) };
815            }
816            elsif($b0==4)
817            {
818                $dict->{Weight}={ 'SID' => splice(@st,-1) };
819            }
820            elsif($b0==5)
821            {
822                $dict->{FontBBX}=[ splice(@st,-4) ];
823            }
824            elsif($b0==13)
825            {
826                $dict->{UniqueID}=splice(@st,-1);
827            }
828            elsif($b0==14)
829            {
830                $dict->{XUID}=[splice(@st,0)];
831            }
832            elsif($b0==15)
833            {
834                $dict->{CharSet}={ 'OFF' => $foff+splice(@st,-1) };
835            }
836            elsif($b0==16)
837            {
838                $dict->{Encoding}={ 'OFF' => $foff+splice(@st,-1) };
839            }
840            elsif($b0==17)
841            {
842                $dict->{CharStrings}={ 'OFF' => $foff+splice(@st,-1) };
843            }
844            elsif($b0==18)
845            {
846                $dict->{Private}={ 'LEN' => splice(@st,-1), 'OFF' => $foff+splice(@st,-1) };
847            }
848            next;
849        }
850        elsif($b0==28) # int16
851        {
852            read($fh,$buf,2);
853            $v=unpack('n',$buf);
854            $v=-(0x10000-$v) if($v>0x7fff);
855        }
856        elsif($b0==29) # int32
857        {
858            read($fh,$buf,4);
859            $v=unpack('N',$buf);
860            $v=-$v+0xffffffff+1 if($v>0x7fffffff);
861        }
862        elsif($b0==30) # float
863        {
864            $e=1;
865            while($e)
866            {
867                read($fh,$buf,1);
868                $v0=unpack('C',$buf);
869                foreach my $m ($v0>>8,$v0&0xf)
870                {
871                    if($m<10)
872                    {
873                        $v.=$m;
874                    }
875                    elsif($m==10)
876                    {
877                        $v.='.';
878                    }
879                    elsif($m==11)
880                    {
881                        $v.='E+';
882                    }
883                    elsif($m==12)
884                    {
885                        $v.='E-';
886                    }
887                    elsif($m==14)
888                    {
889                        $v.='-';
890                    }
891                    elsif($m==15)
892                    {
893                        $e=0;
894                        last;
895                    }
896                }
897            }
898        }
899        elsif($b0==31) # command
900        {
901            $v="c=$b0";
902            next;
903        }
904        elsif($b0<247) # 1 byte signed
905        {
906            $v=$b0-139;
907        }
908        elsif($b0<251) # 2 byte plus
909        {
910            read($fh,$buf,1);
911            $v=unpack('C',$buf);
912            $v=($b0-247)*256+($v+108);
913        }
914        elsif($b0<255) # 2 byte minus
915        {
916            read($fh,$buf,1);
917            $v=unpack('C',$buf);
918            $v=-($b0-251)*256-$v-108;
919        }
920        push @st,$v;
921    }
922
923    return($dict);
924}
925
926
927sub get_otf_data {
928    my $file=shift @_;
929    my $filename=basename($file);
930    my $fh=IO::File->new($file);
931    my $data={};
932    binmode($fh,':raw');
933    my($buf,$ver,$num,$i);
934
935    read($fh,$buf, 12);
936    ($ver, $num) = unpack("Nn", $buf);
937
938    $ver == 1 << 16     # TTF version 1
939        || $ver == 0x74727565   # support Mac sfnts
940        || $ver == 0x4F54544F   # OpenType with diverse Outlines
941        or next; #die "$file not a valid true/opentype font";
942
943    for ($i = 0; $i < $num; $i++)
944    {
945        read($fh,$buf, 16) || last; #die "Reading table entry";
946        my ($name, $check, $off, $len) = unpack("a4NNN", $buf);
947        $data->{$name} = {
948            OFF => $off,
949            LEN => $len,
950        };
951    }
952
953    next unless(defined $data->{name} && defined $data->{'OS/2'});
954
955    $data->{V}={};
956
957    read_name_table($data,$fh);
958
959    read_os2_table($data,$fh);
960
961    read_maxp_table($data,$fh);
962
963    read_head_table($data,$fh);
964
965    read_hhea_table($data,$fh);
966
967    read_hmtx_table($data,$fh);
968
969    read_cmap_table($data,$fh);
970
971    read_post_table($data,$fh);
972
973    if(0)
974    {
975        read_loca_table($data,$fh);
976        read_glyf_table($data,$fh);
977    }
978
979    $data->{V}->{fontfamily}=find_name($data->{name},1);
980    $data->{V}->{fontname}=find_name($data->{name},4);
981    $data->{V}->{stylename}=find_name($data->{name},2);
982
983    my $name = lc find_name($data->{name},1);
984    my $subname = lc find_name($data->{name},2);
985    my $slant='';
986
987    if (defined $subname) {
988        $weight_name = "$subname";
989    } else {
990        $weight_name = "Regular";
991    }
992    $weight_name =~ s/-/ /g;
993
994    $_ = $weight_name;
995    if (/^(regular|normal|medium)$/i) {
996        $weight_name = "Regular";
997        $slant = "";
998        $subname='';
999    } elsif (/^bold$/i) {
1000        $weight_name = "Bold";
1001        $slant = "";
1002        $subname='';
1003    } elsif (/^bold *(italic|oblique)$/i) {
1004        $weight_name = "Bold";
1005        $slant = "-Italic";
1006        $subname='';
1007    } elsif (/^(italic|oblique)$/i) {
1008        $weight_name = "Regular";
1009        $slant = "-Italic";
1010        $subname='';
1011    } else {
1012        # we need to find it via the OS/2 table
1013        if($data->{V}->{usWeightClass} == 0) {
1014            $weight_name = "Regular";
1015        } elsif($data->{V}->{usWeightClass} < 150) {
1016            $weight_name = "Thin";
1017        } elsif($data->{V}->{usWeightClass} < 250) {
1018            $weight_name = "ExtraLight";
1019        } elsif($data->{V}->{usWeightClass} < 350) {
1020            $weight_name = "Light";
1021        } elsif($data->{V}->{usWeightClass} < 450) {
1022            $weight_name = "Regular";
1023        } elsif($data->{V}->{usWeightClass} < 550) {
1024            $weight_name = "Regular";
1025        } elsif($data->{V}->{usWeightClass} < 650) {
1026            $weight_name = "SemiBold";
1027        } elsif($data->{V}->{usWeightClass} < 750) {
1028            $weight_name = "Bold";
1029        } elsif($data->{V}->{usWeightClass} < 850) {
1030            $weight_name = "ExtraBold";
1031        } else {
1032            $weight_name = "Black";
1033        }
1034        # $slant = "";
1035        # $subname='';
1036    }
1037
1038    $data->{V}->{fontweight}=$data->{V}->{usWeightClass};
1039
1040    if($data->{V}->{usWidthClass} == 1) {
1041        $setwidth_name = "-UltraCondensed";
1042        $data->{V}->{fontstretch}="UltraCondensed";
1043    } elsif($data->{V}->{usWidthClass} == 2) {
1044        $setwidth_name = "-ExtraCondensed";
1045        $data->{V}->{fontstretch}="ExtraCondensed";
1046    } elsif($data->{V}->{usWidthClass} == 3) {
1047        $setwidth_name = "-Condensed";
1048        $data->{V}->{fontstretch}="Condensed";
1049    } elsif($data->{V}->{usWidthClass} == 4) {
1050        $setwidth_name = "-SemiCondensed";
1051        $data->{V}->{fontstretch}="SemiCondensed";
1052    } elsif($data->{V}->{usWidthClass} == 5) {
1053        $setwidth_name = "";
1054        $data->{V}->{fontstretch}="Normal";
1055    } elsif($data->{V}->{usWidthClass} == 6) {
1056        $setwidth_name = "-SemiExpanded";
1057        $data->{V}->{fontstretch}="SemiExpanded";
1058    } elsif($data->{V}->{usWidthClass} == 7) {
1059        $setwidth_name = "-Expanded";
1060        $data->{V}->{fontstretch}="Expanded";
1061    } elsif($data->{V}->{usWidthClass} == 8) {
1062        $setwidth_name = "-ExtraExpanded";
1063        $data->{V}->{fontstretch}="ExtraExpanded";
1064    } elsif($data->{V}->{usWidthClass} == 9) {
1065        $setwidth_name = "-UltraExpanded";
1066        $data->{V}->{fontstretch}="UltraExpanded";
1067    } else {
1068        $setwidth_name = ""; # normal | condensed | narrow | semicondensed
1069        $data->{V}->{fontstretch}="Normal";
1070    }
1071
1072    $data->{V}->{fontname}=$name;
1073    $data->{V}->{subname}="$weight_name$slant$setwidth_name";
1074    $data->{V}->{subname}=~s|\-| |g;
1075
1076    if(defined $data->{'CFF '})
1077    {
1078        # read CFF table
1079        seek($fh,$data->{'CFF '}->{OFF},0);
1080        read($fh,$buf, 4);
1081        my ($cffmajor,$cffminor,$cffheadsize,$cffglobaloffsize)=unpack('C4',$buf);
1082
1083        $data->{'CFF '}->{name}=readcffindex($fh,$data->{'CFF '}->{OFF}+$cffheadsize);
1084        foreach my $dict (@{$data->{'CFF '}->{name}})
1085        {
1086            seek($fh,$dict->{OFF},0);
1087            read($fh,$dict->{VAL},$dict->{LEN});
1088        }
1089
1090        $data->{'CFF '}->{topdict}=readcffindex($fh,$data->{'CFF '}->{name}->[-1]->{OFF}+$data->{'CFF '}->{name}->[-1]->{LEN});
1091        foreach my $dict (@{$data->{'CFF '}->{topdict}})
1092        {
1093            $dict->{VAL}=readcffdict($fh,$dict->{OFF},$dict->{LEN},$data->{'CFF '}->{OFF});
1094        }
1095
1096        $data->{'CFF '}->{string}=readcffindex($fh,$data->{'CFF '}->{topdict}->[-1]->{OFF}+$data->{'CFF '}->{topdict}->[-1]->{LEN});
1097        foreach my $dict (@{$data->{'CFF '}->{string}})
1098        {
1099            seek($fh,$dict->{OFF},0);
1100            read($fh,$dict->{VAL},$dict->{LEN});
1101        }
1102        push @{$data->{'CFF '}->{string}},{ 'VAL' => '001.000' };
1103        push @{$data->{'CFF '}->{string}},{ 'VAL' => '001.001' };
1104        push @{$data->{'CFF '}->{string}},{ 'VAL' => '001.002' };
1105        push @{$data->{'CFF '}->{string}},{ 'VAL' => '001.003' };
1106        push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Black' };
1107        push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Bold' };
1108        push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Book' };
1109        push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Light' };
1110        push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Medium' };
1111        push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Regular' };
1112        push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Roman' };
1113        push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Semibold' };
1114
1115        foreach my $dict (@{$data->{'CFF '}->{topdict}})
1116        {
1117            foreach my $k (keys %{$dict->{VAL}})
1118            {
1119                my $dt=$dict->{VAL}->{$k};
1120                if($k eq 'ROS')
1121                {
1122                    $dict->{VAL}->{$k}->[0]=$data->{'CFF '}->{string}->[$dict->{VAL}->{$k}->[0]-391]->{VAL};
1123                    $dict->{VAL}->{$k}->[1]=$data->{'CFF '}->{string}->[$dict->{VAL}->{$k}->[1]-391]->{VAL};
1124                    $data->{V}->{$k}=$dict->{VAL}->{$k};
1125                    next;
1126                }
1127                next unless(ref($dt) eq 'HASH' && defined $dt->{SID});
1128                if($dt->{SID}>=379)
1129                {
1130                    $dict->{VAL}->{$k}=$data->{'CFF '}->{string}->[$dt->{SID}-391]->{VAL};
1131                }
1132            }
1133        }
1134    }
1135
1136    close($fh);
1137
1138    nameByUni();
1139
1140    my $g = scalar @{$data->{V}->{uni}};
1141    $data->{V}->{wx}={};
1142    for(my $i = 0; $i<$g ; $i++)
1143    {
1144    	if(defined $data->{hmtx}->{wx}->[$i])
1145    	{
1146    		$data->{V}->{wx}->{nameByUni($data->{V}->{uni}->[$i])} = $data->{hmtx}->{wx}->[$i];
1147    	}
1148    	else
1149    	{
1150    		$data->{V}->{wx}->{nameByUni($data->{V}->{uni}->[$i])} = $data->{hmtx}->{wx}->[-1];
1151    	}
1152    }
1153
1154    $data->{V}->{glyphs}=$data->{glyf}->{glyphs};
1155    $data=$data->{V};
1156    $data->{firstchar}=0;
1157    $data->{lastchar}=255;
1158
1159    $data->{flags} |= 1 if($data->{isfixedpitch} > 0);
1160    $data->{flags} |= 64 if($data->{italicangle} != 0);
1161    $data->{flags} |= (1<<18) if($data->{usWeightClass} >= 600);
1162
1163    return($data);
1164}
1165
1166
1167sub new
1168{
1169    my ($class,$pdf,$name,%opts) = @_;
1170    my ($self,$data);
1171    $data=get_otf_data($name);
1172
1173    $class = ref $class if ref $class;
1174    $self = $class->SUPER::new($pdf, $data->{apiname}.pdfkey().'~'.time());
1175    $pdf->new_obj($self) unless($self->is_obj($pdf));
1176    $self->{' data'}=$data;
1177    $self->{-dokern}=1 if($opts{-dokern});
1178
1179    $self->{'Subtype'} = PDFName('TrueType');
1180    if($opts{-fontname})
1181    {
1182	    $self->{'BaseFont'} = PDFName($opts{-fontname});
1183    }
1184    else
1185    {
1186    	my $fn=$data->{fontfamily};
1187    	$fn=~s|\s+||go;
1188    	if(($data->{stylename}=~m<(italic|oblique)>i) && ($data->{usWeightClass}>600))
1189    	{
1190	    	$fn.=',BoldItalic';
1191    	}
1192    	elsif($data->{stylename}=~m<(italic|oblique)>i)
1193    	{
1194	    	$fn.=',Italic';
1195    	}
1196    	elsif($data->{usWeightClass}>600)
1197    	{
1198	    	$fn.=',Bold';
1199    	}
1200
1201	    $self->{'BaseFont'} = PDFName($fn);
1202    }
1203    if($opts{-pdfname})
1204    {
1205        $self->name($opts{-pdfname});
1206    }
1207
1208    $self->{FontDescriptor}=$self->descrByData();
1209    $self->encodeByData($opts{-encode});
1210
1211    return($self);
1212}
1213
1214=item $font = PDF::API3::Compat::API2::Resource::Font::neTrueType->new_api $api, $fontname, %options
1215
1216Returns a ne-truetype 8bit only object. This method is different from 'new' that
1217it needs an PDF::API3::Compat::API2-object rather than a PDF::API3::Compat::API2::PDF::File-object.
1218
1219=cut
1220
1221sub new_api
1222{
1223    my ($class,$api,@opts)=@_;
1224
1225    my $obj=$class->new($api->{pdf},@opts);
1226
1227    $api->{pdf}->new_obj($obj) unless($obj->is_obj($api->{pdf}));
1228
1229    $api->{pdf}->out_obj($api->{pages});
1230    return($obj);
1231}
1232
1233
12341;
1235
1236__END__
1237
1238=back
1239
1240=head1 AUTHOR
1241
1242alfred reibenschuh
1243
1244
1245
1246