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