#=======================================================================
# ____ ____ _____ _ ____ ___ ____
# | _ \| _ \| ___| _ _ / \ | _ \_ _| |___ \
# | |_) | | | | |_ (_) (_) / _ \ | |_) | | __) |
# | __/| |_| | _| _ _ / ___ \| __/| | / __/
# |_| |____/|_| (_) (_) /_/ \_\_| |___| |_____|
#
# A Perl Module Chain to faciliate the Creation and Modification
# of High-Quality "Portable Document Format (PDF)" Files.
#
# Copyright 1999-2005 Alfred Reibenschuh <areibens@cpan.org>.
#
#=======================================================================
#
# THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR
# MODIFY IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC
# LICENSE AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; EITHER
# VERSION 2 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
#
# THIS FILE IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL,
# AND ANY EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
# FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT
# SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR CONTRIBUTORS
# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
# OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS FILE, EVEN IF
# ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# SEE THE GNU LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
#
# YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC
# LICENSE ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE
# FREE SOFTWARE FOUNDATION, INC., 59 TEMPLE PLACE - SUITE 330,
# BOSTON, MA 02111-1307, USA.
#
# $Id: neTrueType.pm,v 1.2 2008/01/04 08:10:42 areibens Exp $
#
#=======================================================================
package PDF::API3::Compat::API2::Resource::Font::neTrueType;
=head1 NAME
PDF::API3::Compat::API2::Resource::Font::neTrueType - Module for using 8bit nonembedded truetype Fonts.
=head1 SYNOPSIS
#
use PDF::API3::Compat::API2;
#
$pdf = PDF::API3::Compat::API2->new;
$cft = $pdf->nettfont('Times-Roman.ttf', -encode => 'latin1');
#
=head1 METHODS
=over 4
=cut
BEGIN {
use utf8;
use Encode qw(:all);
use File::Basename;
use vars qw( @ISA $fonts $alias $subs $encodings $VERSION );
use PDF::API3::Compat::API2::Resource::Font;
use PDF::API3::Compat::API2::Util;
use PDF::API3::Compat::API2::Basic::PDF::Utils;
@ISA=qw(PDF::API3::Compat::API2::Resource::Font);
( $VERSION ) = sprintf '%i.%03i', split(/\./,('$Revision: 1.2 $' =~ /Revision: (\S+)\s/)[0]); # $Date: 2008/01/04 08:10:42 $
}
no warnings qw[ deprecated recursion uninitialized ];
=item $font = PDF::API3::Compat::API2::Resource::Font::neTrueType->new $pdf, $fontfile, %options
Returns a corefont object.
=cut
=pod
Valid %options are:
I<-encode>
... changes the encoding of the font from its default.
See I<perl's Encode> for the supported values.
I<-pdfname> ... changes the reference-name of the font from its default.
The reference-name is normally generated automatically and can be
retrived via $pdfname=$font->name.
=cut
sub unpack_fixed
{
my ($dat) = @_;
my ($res, $frac) = unpack("nn", $dat);
$res -= 65536 if $res > 32767;
$res += $frac / 65536.;
return($res);
}
sub unpack_f2dot14
{
my ($dat) = @_;
my $res = unpack("n", $dat);
my $frac = $res & 0x3fff;
$res >>= 14;
$res -= 4 if $res > 1;
$res += $frac / 16384.;
return($res);
}
sub unpack_long
{
my ($dat) = @_;
my $res = unpack("N", $dat);
$res -= (1 << 32) if ($res >= 1 << 31);
return($res);
}
sub unpack_ulong
{
my ($dat) = @_;
my $res = unpack("N", $dat);
return($res);
}
sub unpack_short
{
my ($dat) = @_;
my $res = unpack("n", $dat);
$res -= 65536 if ($res >= 32768);
return($res);
}
sub unpack_ushort
{
my ($dat) = @_;
my $res = unpack("n", $dat);
return($res);
}
sub read_name_table
{
my ($data, $fh, $num, $stroff, $buf) = @_;
# read name table
seek($fh,$data->{name}->{OFF},0);
read($fh,$buf, 6);
($num, $stroff) = unpack("x2nn", $buf);
$data->{name}->{ARR}=[];
for (my $i = 0; $i < $num; $i++)
{
read($fh,$buf, 12);
my ($pid, $eid, $lid, $nid, $len, $off) = unpack("n6", $buf);
push @{$data->{name}->{ARR}},[$pid, $eid, $lid, $nid, $len, $off];
}
foreach my $arr ( @{$data->{name}->{ARR}} ) {
my ($pid, $eid, $lid, $nid, $len, $off) = @{$arr};
seek($fh,$data->{name}->{OFF} + $stroff + $off, 0);
read($fh, $buf, $len);
if ($pid == 0 || $pid == 3 || ($pid == 2 && $eid == 1))
{ $buf = pack('C*',map { $_>255 ? 20 : $_ } unpack('n*',$buf)); }
$data->{name}->{strings}[$nid][$pid][$eid]{$lid} = $buf;
}
}
sub read_os2_table
{
my ($data, $fh, $buf) = @_;
# read OS/2 table
seek($fh,$data->{'OS/2'}->{OFF},0);
read($fh,$buf, 2);
my $os2ver=unpack_ushort($buf);
seek($fh,$data->{'OS/2'}->{OFF}+4,0);
read($fh,$buf, 4);
($data->{V}->{usWeightClass},$data->{V}->{usWidthClass})=unpack('nn',$buf);
seek($fh,$data->{'OS/2'}->{OFF}+30,0);
read($fh,$buf, 12);
$data->{V}->{panoseHex}=unpack('H*',$buf);
$data->{V}->{panose}=$buf;
($data->{V}->{sFamilyClass}, $data->{V}->{bFamilyType}, $data->{V}->{bSerifStyle}, $data->{V}->{bWeight},
$data->{V}->{bProportion}, $data->{V}->{bContrast}, $data->{V}->{bStrokeVariation}, $data->{V}->{bArmStyle},
$data->{V}->{bLetterform}, $data->{V}->{bMidline}, $data->{V}->{bXheight}) = unpack('nC*',$buf);
$data->{V}->{flags} = 0;
$data->{V}->{flags} |= 1 if ($data->{V}->{'bProportion'} == 9);
$data->{V}->{flags} |= 2 unless ($data->{V}->{'bSerifStyle'} > 10 && $data->{V}->{'bSerifStyle'} < 14);
$data->{V}->{flags} |= 8 if ($data->{V}->{'bFamilyType'} == 2);
$data->{V}->{flags} |= 32; # if ($data->{V}->{'bFamilyType'} > 3);
$data->{V}->{flags} |= 64 if ($data->{V}->{'bLetterform'} > 8);
seek($fh,$data->{'OS/2'}->{OFF}+42,0);
read($fh,$buf, 16);
$data->{V}->{ulUnicodeRange}=[ unpack('NNNN',$buf) ];
my @ulCodePageRange=();
if($os2ver>0) {
seek($fh,$data->{'OS/2'}->{OFF}+78,0);
read($fh,$buf, 8);
$data->{V}->{ulCodePageRange}=[ unpack('NN',$buf) ];
read($fh,$buf, 4);
($data->{V}->{xHeight},$data->{V}->{CapHeight})=unpack('nn',$buf);
}
}
sub read_head_table
{
my ($data, $fh, $buf) = @_;
seek($fh,$data->{'head'}->{OFF}+18,0);
read($fh,$buf, 2);
$data->{V}->{upem}=unpack_ushort($buf);
$data->{V}->{upemf}=1000/$data->{V}->{upem};
seek($fh,$data->{'head'}->{OFF}+36,0);
read($fh,$buf, 2);
$data->{V}->{xMin}=unpack_short($buf);
read($fh,$buf, 2);
$data->{V}->{yMin}=unpack_short($buf);
read($fh,$buf, 2);
$data->{V}->{xMax}=unpack_short($buf);
read($fh,$buf, 2);
$data->{V}->{yMax}=unpack_short($buf);
$data->{V}->{fontbbox}=[
int($data->{V}->{'xMin'} * $data->{V}->{upemf}),
int($data->{V}->{'yMin'} * $data->{V}->{upemf}),
int($data->{V}->{'xMax'} * $data->{V}->{upemf}),
int($data->{V}->{'yMax'} * $data->{V}->{upemf})
];
seek($fh,$data->{'head'}->{OFF}+50,0);
read($fh,$data->{'head'}->{indexToLocFormat}, 2);
$data->{'head'}->{indexToLocFormat}=unpack_ushort($data->{'head'}->{indexToLocFormat});
}
sub read_maxp_table
{
my ($data, $fh, $buf) = @_;
seek($fh,$data->{'maxp'}->{OFF}+4,0);
read($fh,$buf, 2);
$data->{V}->{numGlyphs}=unpack_ushort($buf);
$data->{maxp}->{numGlyphs}=$data->{V}->{numGlyphs};
}
sub read_hhea_table
{
my ($data, $fh, $buf) = @_;
seek($fh,$data->{'hhea'}->{OFF}+4,0);
read($fh,$buf, 2);
$data->{V}->{ascender}=unpack_short($buf);
read($fh,$buf, 2);
$data->{V}->{descender}=unpack_short($buf);
read($fh,$buf, 2);
$data->{V}->{linegap}=unpack_short($buf);
read($fh,$buf, 2);
$data->{V}->{advancewidthmax}=unpack_short($buf);
seek($fh,$data->{'hhea'}->{OFF}+34,0);
read($fh,$buf, 2);
$data->{V}->{numberOfHMetrics}=unpack_ushort($buf);
}
sub read_hmtx_table
{
my ($data, $fh, $buf) = @_;
seek($fh,$data->{'hmtx'}->{OFF},0);
$data->{hmtx}->{wx}=[];
foreach (1..$data->{V}->{numberOfHMetrics})
{
read($fh,$buf, 2);
my $wx=int(unpack_ushort($buf)*1000/$data->{V}->{upem});
push @{$data->{hmtx}->{wx}},$wx;
read($fh,$buf, 2);
}
$data->{V}->{missingwidth}=$data->{hmtx}->{wx}->[-1];
}
sub read_cmap_table
{
my ($data, $fh, $buf) = @_;
my $cmap=$data->{cmap};
seek($fh,$cmap->{OFF},0);
read($fh,$buf,4);
$cmap->{Num} = unpack("x2n", $buf);
$cmap->{Tables} = [];
foreach my $i (0..$cmap->{Num})
{
my $s = {};
read($fh,$buf,8);
($s->{Platform}, $s->{Encoding}, $s->{LOC}) = (unpack("nnN", $buf));
$s->{LOC} += $cmap->{OFF};
push(@{$cmap->{Tables}}, $s);
}
foreach my $i (0..$cmap->{Num})
{
my $s = $cmap->{Tables}[$i];
seek($fh,$s->{LOC}, 0);
read($fh,$buf, 2);
$s->{Format} = unpack("n", $buf);
if ($s->{Format} == 0)
{
my $len;
$fh->read($buf, 4);
($len, $s->{Ver}) = unpack('n2', $buf);
$s->{val}={};
foreach my $j (0..255)
{
read($fh,$buf, 1);
$s->{val}->{$j}=unpack('C',$buf);
}
}
elsif ($s->{Format} == 2)
{
# cjk euc ?
}
elsif ($s->{Format} == 4)
{
my ($len,$count);
$fh->read($buf, 12);
($len, $s->{Ver},$count) = unpack('n3', $buf);
$count >>= 1;
$s->{val}={};
read($fh, $buf, $len - 14);
foreach my $j (0..$count-1)
{
my $end = unpack("n", substr($buf, $j << 1, 2));
my $start = unpack("n", substr($buf, ($j << 1) + ($count << 1) + 2, 2));
my $delta = unpack("n", substr($buf, ($j << 1) + ($count << 2) + 2, 2));
$delta -= 65536 if $delta > 32767;
my $range = unpack("n", substr($buf, ($j << 1) + $count * 6 + 2, 2));
foreach my $k ($start..$end)
{
my $id=undef;
if ($range == 0 || $range == 65535) # support the buggy FOG with its range=65535 for final segment
{
$id = $k + $delta;
}
else
{
$id = unpack("n",
substr($buf, ($j << 1) + $count * 6 +
2 + ($k - $start) * 2 + $range, 2)) + $delta;
}
$id -= 65536 if($id >= 65536);
$s->{val}->{$k} = $id if($id);
}
}
}
elsif ($s->{Format} == 6)
{
my ($len,$start,$count);
$fh->read($buf, 8);
($len, $s->{Ver},$start,$count) = unpack('n4', $buf);
$s->{val}={};
foreach my $j (0..$count-1)
{
read($fh,$buf, 2);
$s->{val}->{$start+$j}=unpack('n',$buf);
}
}
elsif ($s->{Format} == 10)
{
my ($len,$start,$count);
$fh->read($buf, 18);
($len, $s->{Ver},$start,$count) = unpack('x2N4', $buf);
$s->{val}={};
foreach my $j (0..$count-1)
{
read($fh,$buf, 2);
$s->{val}->{$start+$j}=unpack('n',$buf);
}
}
elsif ($s->{Format} == 8 || $s->{Format} == 12)
{
my ($len,$count);
$fh->read($buf, 10);
($len, $s->{Ver}) = unpack('x2N2', $buf);
$s->{val}={};
if($s->{Format} == 8)
{
read($fh, $buf, 8192);
read($fh, $buf, 4);
}
else
{
read($fh, $buf, 4);
}
$count = unpack('N', $buf);
foreach my $j (0..$count-1)
{
read($fh,$buf, 12);
my ($start,$end,$cid)=unpack('N3',$buf);
foreach my $k ($start..$end)
{
$s->{val}->{$k}=$cid+$k-$start;
}
}
}
}
my $alt;
foreach my $s (@{$cmap->{Tables}})
{
if($s->{Platform} == 3)
{
$cmap->{mstable} = $s;
last if(($s->{Encoding} == 1) || ($s->{Encoding} == 0));
}
elsif($s->{Platform} == 0 || ($s->{Platform} == 2 && $s->{Encoding} == 1))
{
$alt = $s;
}
}
$cmap->{mstable}||=$alt if($alt);
$data->{V}->{uni}=[];
foreach my $i (keys %{$cmap->{mstable}->{val}})
{
$data->{V}->{uni}->[$cmap->{mstable}->{val}->{$i}]=$i;
}
foreach my $i (0..$data->{V}->{numGlyphs})
{
$data->{V}->{uni}->[$i]||=0;
}
}
sub read_post_table
{
my ($data, $fh, $buf) = @_;
my $post=$data->{post};
seek($fh,$post->{OFF},0);
my @base_set=qw[
.notdef .null nonmarkingreturn space exclam quotedbl numbersign dollar
percent ampersand quotesingle parenleft parenright asterisk plus comma
hyphen period slash zero one two three four five six seven eight nine
colon semicolon less equal greater question at A B C D E F G H I J K L
M N O P Q R S T U V W X Y Z bracketleft backslash bracketright
asciicircum underscore grave a b c d e f g h i j k l m n o p q r s t u
v w x y z braceleft bar braceright asciitilde Adieresis Aring Ccedilla
Eacute Ntilde Odieresis Udieresis aacute agrave acircumflex adieresis
atilde aring ccedilla eacute egrave ecircumflex edieresis iacute
igrave icircumflex idieresis ntilde oacute ograve ocircumflex
odieresis otilde uacute ugrave ucircumflex udieresis dagger degree
cent sterling section bullet paragraph germandbls registered copyright
trademark acute dieresis notequal AE Oslash infinity plusminus
lessequal greaterequal yen mu partialdiff summation product pi
integral ordfeminine ordmasculine Omega ae oslash questiondown
exclamdown logicalnot radical florin approxequal Delta guillemotleft
guillemotright ellipsis nonbreakingspace Agrave Atilde Otilde OE oe
endash emdash quotedblleft quotedblright quoteleft quoteright divide
lozenge ydieresis Ydieresis fraction currency guilsinglleft
guilsinglright fi fl daggerdbl periodcentered quotesinglbase
quotedblbase perthousand Acircumflex Ecircumflex Aacute Edieresis
Egrave Iacute Icircumflex Idieresis Igrave Oacute Ocircumflex apple
Ograve Uacute Ucircumflex Ugrave dotlessi circumflex tilde macron breve
dotaccent ring cedilla hungarumlaut ogonek caron Lslash lslash Scaron
scaron Zcaron zcaron brokenbar Eth eth Yacute yacute Thorn thorn minus
multiply onesuperior twosuperior threesuperior onehalf onequarter
threequarters franc Gbreve gbreve Idotaccent Scedilla scedilla Cacute
cacute Ccaron ccaron dcroat
];
read($fh,$buf, 4);
$post->{Format}=unpack('N',$buf);
read($fh,$buf,4);
$data->{V}->{italicangle}=unpack_fixed($buf);
read($fh,$buf,2);
$data->{V}->{underlineposition}=unpack_f2dot14($buf)*1000;
read($fh,$buf,2);
$data->{V}->{underlinethickness}=unpack_f2dot14($buf)*1000;
read($fh,$buf,4);
$data->{V}->{isfixedpitch}=unpack_ulong($buf);
read($fh,$buf,16);
if($post->{Format} == 0x00010000)
{
$post->{Format}='10';
$post->{val}=[ @base_set ];
$post->{strings}={};
foreach my $i (0..257)
{
$post->{strings}->{$post->{val}->[$i]}=$i;
}
}
elsif($post->{Format} == 0x00020000)
{
$post->{Format}='20';
$post->{val}=[];
$post->{strings}={};
read($fh,$buf,2);
$post->{numGlyphs}=unpack_ushort($buf);
foreach my $i (0..$post->{numGlyphs}-1)
{
read($fh,$buf,2);
$post->{val}->[$i]=unpack_ushort($buf);
}
while(tell($fh) < $post->{OFF}+$post->{LEN})
{
read($fh,$buf,1);
my $strlen=unpack('C',$buf);
read($fh,$buf,$strlen);
push(@base_set,$buf);
}
foreach my $i (0..$post->{numGlyphs}-1)
{
$post->{val}->[$i]=$base_set[$post->{val}->[$i]];
$post->{strings}->{$post->{val}->[$i]}||=$i;
}
}
elsif($post->{Format} == 0x00025000)
{
$post->{Format}='25';
$post->{val}=[];
$post->{strings}={};
read($fh,$buf,2);
my $num=unpack_ushort($buf);
foreach my $i (0..$num)
{
read($fh,$buf,1);
$post->{val}->[$i]=$base_set[$i+unpack('c',$buf)];
$post->{strings}->{$post->{val}->[$i]}||=$i;
}
}
elsif($post->{Format} == 0x00030000)
{
$post->{Format}='30';
$post->{val}=[];
$post->{strings}={};
}
$data->{V}->{name}=[];
foreach my $i (0..$data->{V}->{numGlyphs})
{
$data->{V}->{name}->[$i] = $post->{val}->[$i]
|| nameByUni($data->{V}->{uni}->[$i])
|| '.notdef';
}
$data->{V}->{n2i}={};
foreach my $i (0..$data->{V}->{numGlyphs})
{
$data->{V}->{n2i}->{$data->{V}->{name}->[$i]}||=$i;
}
}
sub read_loca_table
{
my ($data, $fh, $buf) = @_;
seek($fh,$data->{'loca'}->{OFF},0);
my $ilen=$data->{'head'}->{indexToLocFormat} ? 4 : 2;
my $ipak=$data->{'head'}->{indexToLocFormat} ? 'N' : 'n';
my $isif=$data->{'head'}->{indexToLocFormat} ? 0 : 1;
$data->{'loca'}->{gOFF}=[];
for(my $i=0; $i<$data->{'maxp'}->{numGlyphs}+1; $i++)
{
read($fh, $buf, $ilen);
$buf=unpack($ipak,$buf);
$buf<<=$isif;
push @{$data->{'loca'}->{gOFF}},$buf;
}
}
sub read_glyf_table
{
my ($data, $fh, $buf) = @_;
$data->{'glyf'}->{glyphs}=[];
for(my $i=0; $i<$data->{'maxp'}->{numGlyphs}; $i++)
{
my $G={};
$data->{'glyf'}->{glyphs}->[$i]=$G;
next if($data->{'loca'}->{gOFF}->[$i]-$data->{'loca'}->{gOFF}->[$i+1] == 0);
seek($fh,$data->{'loca'}->{gOFF}->[$i]+$data->{'glyf'}->{OFF},0);
read($fh, $buf, 2);
$G->{numOfContours}=unpack_short($buf);
read($fh, $buf, 2);
$G->{xMin}=unpack_short($buf);
read($fh, $buf, 2);
$G->{yMin}=unpack_short($buf);
read($fh, $buf, 2);
$G->{xMax}=unpack_short($buf);
read($fh, $buf, 2);
$G->{yMax}=unpack_short($buf);
}
}
sub find_name
{
my ($self, $nid) = @_;
my ($res, $pid, $eid, $lid, $look, $k);
my (@lookup) = ([3, 1, 1033], [3, 1, -1], [2, 1, -1], [2, 2, -1], [2, 0, -1],
[0, 0, 0], [1, 0, 0]);
foreach $look (@lookup)
{
($pid, $eid, $lid) = @$look;
if ($lid == -1)
{
foreach $k (keys %{$self->{'strings'}->[$nid]->[$pid]->[$eid]})
{
if (($res = $self->{strings}->[$nid]->[$pid]->[$eid]->{$k}) ne '')
{
$lid = $k;
last;
}
}
} else
{ $res = $self->{strings}->[$nid]->[$pid]->[$eid]->{$lid} }
if ($res ne '')
{ return wantarray ? ($res, $pid, $eid, $lid) : $res; }
}
return '';
}
sub readcffindex
{
my ($fh,$off,$buf)=@_;
my @idx=();
my $index=[];
seek($fh,$off,0);
read($fh,$buf,3);
my ($count,$offsize)=unpack('nC',$buf);
foreach (0..$count)
{
read($fh,$buf,$offsize);
$buf=substr("\x00\x00\x00$buf",-4,4);
my $id=unpack('N',$buf);
push @idx,$id;
}
my $dataoff=tell($fh)-1;
foreach my $i (0..$count-1)
{
push @{$index},{ 'OFF' => $dataoff+$idx[$i], 'LEN' => $idx[$i+1]-$idx[$i] };
}
return($index);
}
sub readcffdict
{
my ($fh,$off,$len,$foff,$buf)=@_;
my @idx=();
my $dict={};
seek($fh,$off,0);
my @st=();
while(tell($fh)<($off+$len))
{
read($fh,$buf,1);
my $b0=unpack('C',$buf);
my $v='';
if($b0==12) # two byte commands
{
read($fh,$buf,1);
my $b1=unpack('C',$buf);
if($b1==0)
{
$dict->{Copyright}={ 'SID' => splice(@st,-1) };
}
elsif($b1==1)
{
$dict->{isFixedPitch}=splice(@st,-1);
}
elsif($b1==2)
{
$dict->{ItalicAngle}=splice(@st,-1);
}
elsif($b1==3)
{
$dict->{UnderlinePosition}=splice(@st,-1);
}
elsif($b1==4)
{
$dict->{UnderlineThickness}=splice(@st,-1);
}
elsif($b1==5)
{
$dict->{PaintType}=splice(@st,-1);
}
elsif($b1==6)
{
$dict->{CharstringType}=splice(@st,-1);
}
elsif($b1==7)
{
$dict->{FontMatrix}=[ splice(@st,-4) ];
}
elsif($b1==8)
{
$dict->{StrokeWidth}=splice(@st,-1);
}
elsif($b1==20)
{
$dict->{SyntheticBase}=splice(@st,-1);
}
elsif($b1==21)
{
$dict->{PostScript}={ 'SID' => splice(@st,-1) };
}
elsif($b1==22)
{
$dict->{BaseFontName}={ 'SID' => splice(@st,-1) };
}
elsif($b1==23)
{
$dict->{BaseFontBlend}=[ splice(@st,0) ];
}
elsif($b1==24)
{
$dict->{MultipleMaster}=[ splice(@st,0) ];
}
elsif($b1==25)
{
$dict->{BlendAxisTypes}=[ splice(@st,0) ];
}
elsif($b1==30)
{
$dict->{ROS}=[ splice(@st,-3) ];
}
elsif($b1==31)
{
$dict->{CIDFontVersion}=splice(@st,-1);
}
elsif($b1==32)
{
$dict->{CIDFontRevision}=splice(@st,-1);
}
elsif($b1==33)
{
$dict->{CIDFontType}=splice(@st,-1);
}
elsif($b1==34)
{
$dict->{CIDCount}=splice(@st,-1);
}
elsif($b1==35)
{
$dict->{UIDBase}=splice(@st,-1);
}
elsif($b1==36)
{
$dict->{FDArray}={ 'OFF' => $foff+splice(@st,-1) };
}
elsif($b1==37)
{
$dict->{FDSelect}={ 'OFF' => $foff+splice(@st,-1) };
}
elsif($b1==38)
{
$dict->{FontName}={ 'SID' => splice(@st,-1) };
}
elsif($b1==39)
{
$dict->{Chameleon}=splice(@st,-1);
}
next;
}
elsif($b0<28) # commands
{
if($b0==0)
{
$dict->{Version}={ 'SID' => splice(@st,-1) };
}
elsif($b0==1)
{
$dict->{Notice}={ 'SID' => splice(@st,-1) };
}
elsif($b0==2)
{
$dict->{FullName}={ 'SID' => splice(@st,-1) };
}
elsif($b0==3)
{
$dict->{FamilyName}={ 'SID' => splice(@st,-1) };
}
elsif($b0==4)
{
$dict->{Weight}={ 'SID' => splice(@st,-1) };
}
elsif($b0==5)
{
$dict->{FontBBX}=[ splice(@st,-4) ];
}
elsif($b0==13)
{
$dict->{UniqueID}=splice(@st,-1);
}
elsif($b0==14)
{
$dict->{XUID}=[splice(@st,0)];
}
elsif($b0==15)
{
$dict->{CharSet}={ 'OFF' => $foff+splice(@st,-1) };
}
elsif($b0==16)
{
$dict->{Encoding}={ 'OFF' => $foff+splice(@st,-1) };
}
elsif($b0==17)
{
$dict->{CharStrings}={ 'OFF' => $foff+splice(@st,-1) };
}
elsif($b0==18)
{
$dict->{Private}={ 'LEN' => splice(@st,-1), 'OFF' => $foff+splice(@st,-1) };
}
next;
}
elsif($b0==28) # int16
{
read($fh,$buf,2);
$v=unpack('n',$buf);
$v=-(0x10000-$v) if($v>0x7fff);
}
elsif($b0==29) # int32
{
read($fh,$buf,4);
$v=unpack('N',$buf);
$v=-$v+0xffffffff+1 if($v>0x7fffffff);
}
elsif($b0==30) # float
{
$e=1;
while($e)
{
read($fh,$buf,1);
$v0=unpack('C',$buf);
foreach my $m ($v0>>8,$v0&0xf)
{
if($m<10)
{
$v.=$m;
}
elsif($m==10)
{
$v.='.';
}
elsif($m==11)
{
$v.='E+';
}
elsif($m==12)
{
$v.='E-';
}
elsif($m==14)
{
$v.='-';
}
elsif($m==15)
{
$e=0;
last;
}
}
}
}
elsif($b0==31) # command
{
$v="c=$b0";
next;
}
elsif($b0<247) # 1 byte signed
{
$v=$b0-139;
}
elsif($b0<251) # 2 byte plus
{
read($fh,$buf,1);
$v=unpack('C',$buf);
$v=($b0-247)*256+($v+108);
}
elsif($b0<255) # 2 byte minus
{
read($fh,$buf,1);
$v=unpack('C',$buf);
$v=-($b0-251)*256-$v-108;
}
push @st,$v;
}
return($dict);
}
sub get_otf_data {
my $file=shift @_;
my $filename=basename($file);
my $fh=IO::File->new($file);
my $data={};
binmode($fh,':raw');
my($buf,$ver,$num,$i);
read($fh,$buf, 12);
($ver, $num) = unpack("Nn", $buf);
$ver == 1 << 16 # TTF version 1
|| $ver == 0x74727565 # support Mac sfnts
|| $ver == 0x4F54544F # OpenType with diverse Outlines
or next; #die "$file not a valid true/opentype font";
for ($i = 0; $i < $num; $i++)
{
read($fh,$buf, 16) || last; #die "Reading table entry";
my ($name, $check, $off, $len) = unpack("a4NNN", $buf);
$data->{$name} = {
OFF => $off,
LEN => $len,
};
}
next unless(defined $data->{name} && defined $data->{'OS/2'});
$data->{V}={};
read_name_table($data,$fh);
read_os2_table($data,$fh);
read_maxp_table($data,$fh);
read_head_table($data,$fh);
read_hhea_table($data,$fh);
read_hmtx_table($data,$fh);
read_cmap_table($data,$fh);
read_post_table($data,$fh);
if(0)
{
read_loca_table($data,$fh);
read_glyf_table($data,$fh);
}
$data->{V}->{fontfamily}=find_name($data->{name},1);
$data->{V}->{fontname}=find_name($data->{name},4);
$data->{V}->{stylename}=find_name($data->{name},2);
my $name = lc find_name($data->{name},1);
my $subname = lc find_name($data->{name},2);
my $slant='';
if (defined $subname) {
$weight_name = "$subname";
} else {
$weight_name = "Regular";
}
$weight_name =~ s/-/ /g;
$_ = $weight_name;
if (/^(regular|normal|medium)$/i) {
$weight_name = "Regular";
$slant = "";
$subname='';
} elsif (/^bold$/i) {
$weight_name = "Bold";
$slant = "";
$subname='';
} elsif (/^bold *(italic|oblique)$/i) {
$weight_name = "Bold";
$slant = "-Italic";
$subname='';
} elsif (/^(italic|oblique)$/i) {
$weight_name = "Regular";
$slant = "-Italic";
$subname='';
} else {
# we need to find it via the OS/2 table
if($data->{V}->{usWeightClass} == 0) {
$weight_name = "Regular";
} elsif($data->{V}->{usWeightClass} < 150) {
$weight_name = "Thin";
} elsif($data->{V}->{usWeightClass} < 250) {
$weight_name = "ExtraLight";
} elsif($data->{V}->{usWeightClass} < 350) {
$weight_name = "Light";
} elsif($data->{V}->{usWeightClass} < 450) {
$weight_name = "Regular";
} elsif($data->{V}->{usWeightClass} < 550) {
$weight_name = "Regular";
} elsif($data->{V}->{usWeightClass} < 650) {
$weight_name = "SemiBold";
} elsif($data->{V}->{usWeightClass} < 750) {
$weight_name = "Bold";
} elsif($data->{V}->{usWeightClass} < 850) {
$weight_name = "ExtraBold";
} else {
$weight_name = "Black";
}
# $slant = "";
# $subname='';
}
$data->{V}->{fontweight}=$data->{V}->{usWeightClass};
if($data->{V}->{usWidthClass} == 1) {
$setwidth_name = "-UltraCondensed";
$data->{V}->{fontstretch}="UltraCondensed";
} elsif($data->{V}->{usWidthClass} == 2) {
$setwidth_name = "-ExtraCondensed";
$data->{V}->{fontstretch}="ExtraCondensed";
} elsif($data->{V}->{usWidthClass} == 3) {
$setwidth_name = "-Condensed";
$data->{V}->{fontstretch}="Condensed";
} elsif($data->{V}->{usWidthClass} == 4) {
$setwidth_name = "-SemiCondensed";
$data->{V}->{fontstretch}="SemiCondensed";
} elsif($data->{V}->{usWidthClass} == 5) {
$setwidth_name = "";
$data->{V}->{fontstretch}="Normal";
} elsif($data->{V}->{usWidthClass} == 6) {
$setwidth_name = "-SemiExpanded";
$data->{V}->{fontstretch}="SemiExpanded";
} elsif($data->{V}->{usWidthClass} == 7) {
$setwidth_name = "-Expanded";
$data->{V}->{fontstretch}="Expanded";
} elsif($data->{V}->{usWidthClass} == 8) {
$setwidth_name = "-ExtraExpanded";
$data->{V}->{fontstretch}="ExtraExpanded";
} elsif($data->{V}->{usWidthClass} == 9) {
$setwidth_name = "-UltraExpanded";
$data->{V}->{fontstretch}="UltraExpanded";
} else {
$setwidth_name = ""; # normal | condensed | narrow | semicondensed
$data->{V}->{fontstretch}="Normal";
}
$data->{V}->{fontname}=$name;
$data->{V}->{subname}="$weight_name$slant$setwidth_name";
$data->{V}->{subname}=~s|\-| |g;
if(defined $data->{'CFF '})
{
# read CFF table
seek($fh,$data->{'CFF '}->{OFF},0);
read($fh,$buf, 4);
my ($cffmajor,$cffminor,$cffheadsize,$cffglobaloffsize)=unpack('C4',$buf);
$data->{'CFF '}->{name}=readcffindex($fh,$data->{'CFF '}->{OFF}+$cffheadsize);
foreach my $dict (@{$data->{'CFF '}->{name}})
{
seek($fh,$dict->{OFF},0);
read($fh,$dict->{VAL},$dict->{LEN});
}
$data->{'CFF '}->{topdict}=readcffindex($fh,$data->{'CFF '}->{name}->[-1]->{OFF}+$data->{'CFF '}->{name}->[-1]->{LEN});
foreach my $dict (@{$data->{'CFF '}->{topdict}})
{
$dict->{VAL}=readcffdict($fh,$dict->{OFF},$dict->{LEN},$data->{'CFF '}->{OFF});
}
$data->{'CFF '}->{string}=readcffindex($fh,$data->{'CFF '}->{topdict}->[-1]->{OFF}+$data->{'CFF '}->{topdict}->[-1]->{LEN});
foreach my $dict (@{$data->{'CFF '}->{string}})
{
seek($fh,$dict->{OFF},0);
read($fh,$dict->{VAL},$dict->{LEN});
}
push @{$data->{'CFF '}->{string}},{ 'VAL' => '001.000' };
push @{$data->{'CFF '}->{string}},{ 'VAL' => '001.001' };
push @{$data->{'CFF '}->{string}},{ 'VAL' => '001.002' };
push @{$data->{'CFF '}->{string}},{ 'VAL' => '001.003' };
push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Black' };
push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Bold' };
push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Book' };
push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Light' };
push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Medium' };
push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Regular' };
push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Roman' };
push @{$data->{'CFF '}->{string}},{ 'VAL' => 'Semibold' };
foreach my $dict (@{$data->{'CFF '}->{topdict}})
{
foreach my $k (keys %{$dict->{VAL}})
{
my $dt=$dict->{VAL}->{$k};
if($k eq 'ROS')
{
$dict->{VAL}->{$k}->[0]=$data->{'CFF '}->{string}->[$dict->{VAL}->{$k}->[0]-391]->{VAL};
$dict->{VAL}->{$k}->[1]=$data->{'CFF '}->{string}->[$dict->{VAL}->{$k}->[1]-391]->{VAL};
$data->{V}->{$k}=$dict->{VAL}->{$k};
next;
}
next unless(ref($dt) eq 'HASH' && defined $dt->{SID});
if($dt->{SID}>=379)
{
$dict->{VAL}->{$k}=$data->{'CFF '}->{string}->[$dt->{SID}-391]->{VAL};
}
}
}
}
close($fh);
nameByUni();
my $g = scalar @{$data->{V}->{uni}};
$data->{V}->{wx}={};
for(my $i = 0; $i<$g ; $i++)
{
if(defined $data->{hmtx}->{wx}->[$i])
{
$data->{V}->{wx}->{nameByUni($data->{V}->{uni}->[$i])} = $data->{hmtx}->{wx}->[$i];
}
else
{
$data->{V}->{wx}->{nameByUni($data->{V}->{uni}->[$i])} = $data->{hmtx}->{wx}->[-1];
}
}
$data->{V}->{glyphs}=$data->{glyf}->{glyphs};
$data=$data->{V};
$data->{firstchar}=0;
$data->{lastchar}=255;
$data->{flags} |= 1 if($data->{isfixedpitch} > 0);
$data->{flags} |= 64 if($data->{italicangle} != 0);
$data->{flags} |= (1<<18) if($data->{usWeightClass} >= 600);
return($data);
}
sub new
{
my ($class,$pdf,$name,%opts) = @_;
my ($self,$data);
$data=get_otf_data($name);
$class = ref $class if ref $class;
$self = $class->SUPER::new($pdf, $data->{apiname}.pdfkey().'~'.time());
$pdf->new_obj($self) unless($self->is_obj($pdf));
$self->{' data'}=$data;
$self->{-dokern}=1 if($opts{-dokern});
$self->{'Subtype'} = PDFName('TrueType');
if($opts{-fontname})
{
$self->{'BaseFont'} = PDFName($opts{-fontname});
}
else
{
my $fn=$data->{fontfamily};
$fn=~s|\s+||go;
if(($data->{stylename}=~m<(italic|oblique)>i) && ($data->{usWeightClass}>600))
{
$fn.=',BoldItalic';
}
elsif($data->{stylename}=~m<(italic|oblique)>i)
{
$fn.=',Italic';
}
elsif($data->{usWeightClass}>600)
{
$fn.=',Bold';
}
$self->{'BaseFont'} = PDFName($fn);
}
if($opts{-pdfname})
{
$self->name($opts{-pdfname});
}
$self->{FontDescriptor}=$self->descrByData();
$self->encodeByData($opts{-encode});
return($self);
}
=item $font = PDF::API3::Compat::API2::Resource::Font::neTrueType->new_api $api, $fontname, %options
Returns a ne-truetype 8bit only object. This method is different from 'new' that
it needs an PDF::API3::Compat::API2-object rather than a PDF::API3::Compat::API2::PDF::File-object.
=cut
sub new_api
{
my ($class,$api,@opts)=@_;
my $obj=$class->new($api->{pdf},@opts);
$api->{pdf}->new_obj($obj) unless($obj->is_obj($api->{pdf}));
$api->{pdf}->out_obj($api->{pages});
return($obj);
}
1;
__END__
=back
=head1 AUTHOR
alfred reibenschuh