1#======================================================================= 2# ____ ____ _____ _ ____ ___ ____ 3# | _ \| _ \| ___| _ _ / \ | _ \_ _| |___ \ 4# | |_) | | | | |_ (_) (_) / _ \ | |_) | | __) | 5# | __/| |_| | _| _ _ / ___ \| __/| | / __/ 6# |_| |____/|_| (_) (_) /_/ \_\_| |___| |_____| 7# 8# A Perl Module Chain to faciliate the Creation and Modification 9# of High-Quality "Portable Document Format (PDF)" Files. 10# 11#======================================================================= 12# 13# THIS IS A REUSED PERL MODULE, FOR PROPER LICENCING TERMS SEE BELOW: 14# 15# 16# Copyright Martin Hosken <Martin_Hosken@sil.org> 17# 18# No warranty or expression of effectiveness, least of all regarding 19# anyone's safety, is implied in this software or documentation. 20# 21# This specific module is licensed under the Perl Artistic License. 22# 23# 24# $Id: Ttopen.pm,v 2.0 2005/11/16 02:16:00 areibens Exp $ 25# 26#======================================================================= 27package PDF::API3::Compat::API2::Basic::TTF::Ttopen; 28 29=head1 NAME 30 31PDF::API3::Compat::API2::Basic::TTF::Ttopen - Opentype superclass for standard Opentype lookup based tables 32(GSUB and GPOS) 33 34=head1 DESCRIPTION 35 36Handles all the script, lang, feature, lookup stuff for a 37L<PDF::API3::Compat::API2::Basic::TTF::Gsub>/L<PDF::API3::Compat::API2::Basic::TTF::Gpos> table leaving the class specifics to the 38subclass 39 40=head1 INSTANCE VARIABLES 41 42The instance variables of an opentype table form a complex sub-module hierarchy. 43 44=over 4 45 46=item Version 47 48This contains the version of the table as a floating point number 49 50=item SCRIPTS 51 52The scripts list is a hash of script tags. Each script tag (of the form 53$t->{'SCRIPTS'}{$tag}) has information below it. 54 55=over 8 56 57=item OFFSET 58 59This variable is preceeded by a space and gives the offset from the start of the 60table (not the table section) to the script table for this script 61 62=item REFTAG 63 64This variable is preceded by a space and gives a corresponding script tag to this 65one such that the offsets in the file are the same. When writing, it is up to the 66caller to ensure that the REFTAGs are set correctly, since these will be used to 67assume that the scripts are identical. Note that REFTAG must refer to a script which 68has no REFTAG of its own. 69 70=item DEFAULT 71 72This corresponds to the default language for this script, if there is one, and 73contains the same information as an itemised language 74 75=item LANG_TAGS 76 77This contains an array of language tag strings (each 4 bytes) corresponding to 78the languages listed by this script 79 80=item $lang 81 82Each language is a hash containing its information: 83 84=over 12 85 86=item OFFSET 87 88This variable is preceeded by a a space and gives the offset from the start of 89the whole table to the language table for this language 90 91=item REFTAG 92 93This variable is preceded by a space and has the same function as for the script 94REFTAG, only for the languages within a script. 95 96=item RE-ORDER 97 98This indicates re-ordering information, and has not been set. The value should 99always be 0. 100 101=item DEFAULT 102 103This holds the index of the default feature, if there is one, or -1 otherwise. 104 105=item FEATURES 106 107This is an array of feature indices which index into the FEATURES instance 108variable of the table 109 110=back 111 112=back 113 114=item FEATURES 115 116The features section of instance variables corresponds to the feature table in 117the opentype table. 118 119=over 8 120 121=item FEAT_TAGS 122 123This array gives the ordered list of feature tags for this table. It is used during 124reading and writing for converting between feature index and feature tag. 125 126=back 127 128The rest of the FEATURES variable is itself a hash based on the feature tag for 129each feature. Each feature has the following structure: 130 131=over 8 132 133=item OFFSET 134 135This attribute is preceeded by a space and gives the offset relative to the start of the whole 136table of this particular feature. 137 138=item PARMS 139 140This is an unused offset to the parameters for each feature 141 142=item LOOKUPS 143 144This is an array containing indices to lookups in the LOOKUP instance variable of the table 145 146=item INDEX 147 148This gives the feature index for this feature and is used during reading and writing for 149converting between feature tag and feature index. 150 151=back 152 153=item LOOKUP 154 155This variable is an array of lookups in order and is indexed via the features of a language of a 156script. Each lookup contains subtables and other information: 157 158=over 8 159 160=item OFFSET 161 162This name is preceeded by a space and contains the offset from the start of the table to this 163particular lookup 164 165=item TYPE 166 167This is a subclass specific type for a lookup. It stipulates the type of lookup and hence subtables 168within the lookup 169 170=item FLAG 171 172Holds the lookup flag bits 173 174=item SUB 175 176This holds an array of subtables which are subclass specific. Each subtable must have 177an OFFSET. The other variables described here are an abstraction used in both the 178GSUB and GPOS tables which are the target subclasses of this class. 179 180=over 12 181 182=item OFFSET 183 184This is preceeded by a space and gives the offset relative to the start of the table for this 185subtable 186 187=item FORMAT 188 189Gives the sub-table sub format for this GSUB subtable. It is assumed that this 190value is correct when it comes time to write the subtable. 191 192=item COVERAGE 193 194Most lookups consist of a coverage table corresponding to the first 195glyph to match. The offset of this coverage table is stored here and the coverage 196table looked up against the GSUB table proper. There are two lookups 197without this initial coverage table which is used to index into the RULES array. 198These lookups have one element in the RULES array which is used for the whole 199match. 200 201=item RULES 202 203The rules are a complex array. Each element of the array corresponds to an 204element in the coverage table (governed by the coverage index). If there is 205no coverage table, then there is considered to be only one element in the rules 206array. Each element of the array is itself an array corresponding to the 207possibly multiple string matches which may follow the initial glyph. Each 208element of this array is a hash with fixed keys corresponding to information 209needed to match a glyph string or act upon it. Thus the RULES element is an 210array of arrays of hashes which contain the following keys: 211 212=over 16 213 214=item MATCH 215 216This contains a sequence of elements held as an array. The elements may be 217glyph ids (gid), class ids (cids), or offsets to coverage tables. Each element 218corresponds to one glyph in the glyph string. See MATCH_TYPE for details of 219how the different element types are marked. 220 221=item PRE 222 223This array holds the sequence of elements preceeding the first match element 224and has the same form as the MATCH array. 225 226=item POST 227 228This array holds the sequence of elements to be tested for following the match 229string and is of the same form as the MATCH array. 230 231=item ACTION 232 233This array holds information regarding what should be done if a match is found. 234The array may either hold glyph ids (which are used to replace or insert or 235whatever glyphs in the glyph string) or 2 element arrays consisting of: 236 237=over 20 238 239=item OFFSET 240 241Offset from the start of the matched string that the lookup should start at 242when processing the substring. 243 244=item LOOKUP_INDEX 245 246The index to a lookup to be acted upon on the match string. 247 248=back 249 250=back 251 252=back 253 254=back 255 256=item CLASS 257 258For those lookups which use class categories rather than glyph ids for matching 259this is the offset to the class definition used to categories glyphs in the 260match string. 261 262=item PRE_CLASS 263 264This is the offset to the class definition for the before match glyphs 265 266=item POST_CLASS 267 268This is the offset to the class definition for the after match glyphs. 269 270=item ACTION_TYPE 271 272This string holds the type of information held in the ACTION variable of a RULE. 273It is subclass specific. 274 275=item MATCH_TYPE 276 277This holds the type of information in the MATCH array of a RULE. This is subclass 278specific. 279 280=item ADJUST 281 282This corresponds to a single action for all items in a coverage table. The meaning 283is subclass specific. 284 285=item CACHE 286 287This key starts with a space 288 289A hash of other tables (such as coverage tables, classes, anchors, device tables) 290based on the offset given in the subtable to that other information. 291Note that the documentation is particularly 292unhelpful here in that such tables are given as offsets relative to the 293beginning of the subtable not the whole GSUB table. This includes those items which 294are stored relative to another base within the subtable. 295 296=back 297 298 299=head1 METHODS 300 301=cut 302 303use PDF::API3::Compat::API2::Basic::TTF::Table; 304use PDF::API3::Compat::API2::Basic::TTF::Utils; 305use PDF::API3::Compat::API2::Basic::TTF::Coverage; 306use strict; 307use vars qw(@ISA); 308 309@ISA = qw(PDF::API3::Compat::API2::Basic::TTF::Table); 310 311=head2 $t->read 312 313Reads the table passing control to the subclass to handle the subtable specifics 314 315=cut 316 317sub read 318{ 319 my ($self) = @_; 320 my ($dat, $i, $l, $oScript, $oFeat, $oLook, $tag, $nScript, $off, $dLang, $nLang, $lTag); 321 my ($nFeat, $nLook, $nSub, $j, $temp); 322 my ($fh) = $self->{' INFILE'}; 323 my ($moff) = $self->{' OFFSET'}; 324 325 $self->SUPER::read or return $self; 326 $fh->read($dat, 10); 327 ($self->{'Version'}, $oScript, $oFeat, $oLook) = TTF_Unpack("fSSS", $dat); 328 329# read features first so that in the script/lang hierarchy we can use feature tags 330 331 $fh->seek($moff + $oFeat, 0); 332 $fh->read($dat, 2); 333 $nFeat = unpack("n", $dat); 334 $self->{'FEATURES'} = {}; 335 $l = $self->{'FEATURES'}; 336 $fh->read($dat, 6 * $nFeat); 337 for ($i = 0; $i < $nFeat; $i++) 338 { 339 ($tag, $off) = unpack("a4n", substr($dat, $i * 6, 6)); 340 while (defined $l->{$tag}) 341 { 342 if ($tag =~ m/(.*?)\s_(\d+)$/o) 343 { $tag = $1 . " _" . ($2 + 1); } 344 elsef 345 { $tag .= " _0"; } 346 } 347 $l->{$tag}{' OFFSET'} = $off + $oFeat; 348 $l->{$tag}{'INDEX'} = $i; 349 push (@{$l->{'FEAT_TAGS'}}, $tag); 350 } 351 352 foreach $tag (grep {length($_) == 4} keys %$l) 353 { 354 $fh->seek($moff + $l->{$tag}{' OFFSET'}, 0); 355 $fh->read($dat, 4); 356 ($l->{$tag}{'PARMS'}, $nLook) = unpack("n2", $dat); 357 $fh->read($dat, $nLook * 2); 358 $l->{$tag}{'LOOKUPS'} = [unpack("n*", $dat)]; 359 } 360 361# Now the script/lang hierarchy 362 363 $fh->seek($moff + $oScript, 0); 364 $fh->read($dat, 2); 365 $nScript = unpack("n", $dat); 366 $self->{'SCRIPTS'} = {}; 367 $l = $self->{'SCRIPTS'}; 368 $fh->read($dat, 6 * $nScript); 369 for ($i = 0; $i < $nScript; $i++) 370 { 371 ($tag, $off) = unpack("a4n", substr($dat, $i * 6, 6)); 372 $off += $oScript; 373 foreach (keys %$l) 374 { $l->{$tag}{' REFTAG'} = $_ if ($l->{$_}{' OFFSET'} == $off 375 && !defined $l->{$_}{' REFTAG'}); } 376 $l->{$tag}{' OFFSET'} = $off; 377 } 378 379 foreach $tag (keys %$l) 380 { 381 next if ($l->{$tag}{' REFTAG'}); 382 $fh->seek($moff + $l->{$tag}{' OFFSET'}, 0); 383 $fh->read($dat, 4); 384 ($dLang, $nLang) = unpack("n2", $dat); 385 $l->{$tag}{'DEFAULT'}{' OFFSET'} = 386 $dLang + $l->{$tag}{' OFFSET'} if $dLang; 387 $fh->read($dat, 6 * $nLang); 388 for ($i = 0; $i < $nLang; $i++) 389 { 390 ($lTag, $off) = unpack("a4n", substr($dat, $i * 6, 6)); 391 $off += $l->{$tag}{' OFFSET'}; 392 $l->{$tag}{$lTag}{' OFFSET'} = $off; 393 foreach (@{$l->{$tag}{'LANG_TAGS'}}) 394 { $l->{$tag}{$lTag}{' REFTAG'} = $_ if ($l->{$tag}{$_}{' OFFSET'} == $off 395 && !$l->{$tag}{$_}{' REFTAG'}); } 396 push (@{$l->{$tag}{'LANG_TAGS'}}, $lTag); 397 } 398 foreach $lTag (@{$l->{$tag}{'LANG_TAGS'}}, 'DEFAULT') 399 { 400 next unless defined $l->{$tag}{$lTag}; 401 next if ($l->{$tag}{$lTag}{' REFTAG'}); 402 $fh->seek($moff + $l->{$tag}{$lTag}{' OFFSET'}, 0); 403 $fh->read($dat, 6); 404 ($l->{$tag}{$lTag}{'RE-ORDER'}, $l->{$tag}{$lTag}{'DEFAULT'}, $nFeat) 405 = unpack("n3", $dat); 406 $fh->read($dat, $nFeat * 2); 407 $l->{$tag}{$lTag}{'FEATURES'} = [map {$self->{'FEATURES'}{'FEAT_TAGS'}[$_]} unpack("n*", $dat)]; 408 } 409 foreach $lTag (@{$l->{$tag}{'LANG_TAGS'}}, 'DEFAULT') 410 { 411 next unless $l->{$tag}{$lTag}{' REFTAG'}; 412 $temp = $l->{$tag}{$lTag}{' REFTAG'}; 413 $l->{$tag}{$lTag} = ©($l->{$tag}{$temp}); 414 $l->{$tag}{' REFTAG'} = $temp; 415 } 416 } 417 foreach $tag (keys %$l) 418 { 419 next unless $l->{$tag}{' REFTAG'}; 420 $temp = $l->{$tag}{' REFTAG'}; 421 $l->{$tag} = ©($l->{$temp}); 422 $l->{$tag}{' REFTAG'} = $temp; 423 } 424 425# And finally the lookups 426 427 $fh->seek($moff + $oLook, 0); 428 $fh->read($dat, 2); 429 $nLook = unpack("n", $dat); 430 $fh->read($dat, $nLook * 2); 431 $i = 0; 432 map { $self->{'LOOKUP'}[$i++]{' OFFSET'} = $_; } unpack("n*", $dat); 433 434 for ($i = 0; $i < $nLook; $i++) 435 { 436 $l = $self->{'LOOKUP'}[$i]; 437 $fh->seek($l->{' OFFSET'} + $moff + $oLook, 0); 438 $fh->read($dat, 6); 439 ($l->{'TYPE'}, $l->{'FLAG'}, $nSub) = unpack("n3", $dat); 440 $fh->read($dat, $nSub * 2); 441 $j = 0; 442 map { $l->{'SUB'}[$j]{' OFFSET'} = $_; } unpack("n*", $dat); 443 for ($j = 0; $j < $nSub; $j++) 444 { 445 $fh->seek($moff + $oLook + $l->{' OFFSET'} + $l->{'SUB'}[$j]{' OFFSET'}, 0); 446 $self->read_sub($fh, $l, $j); 447 } 448 } 449 return $self; 450} 451 452=head2 $t->read_sub($fh, $lookup, $index) 453 454This stub is to allow subclasses to read subtables of lookups in a table specific manner. A 455reference to the lookup is passed in along with the subtable index. The file is located at the 456start of the subtable to be read 457 458=cut 459 460sub read_sub 461{ } 462 463 464=head2 $t->extension() 465 466Returns the lookup number for the extension table that allows access to 32-bit offsets. 467 468=cut 469 470sub extension 471{ } 472 473 474=head2 $t->out($fh) 475 476Writes this Opentype table to the output calling $t->out_sub for each sub table 477at the appropriate point in the output. The assumption is that on entry the 478number of scripts, languages, features, lookups, etc. are all resolved and 479the relationships fixed. This includes a script's LANG_TAGS list and that all 480scripts and languages in their respective dictionaries either have a REFTAG or contain 481real data. 482 483=cut 484 485sub out 486{ 487 my ($self, $fh) = @_; 488 my ($i, $j, $base, $off, $tag, $t, $l, $lTag, $oScript, @script, @tags); 489 my ($end, $nTags, @offs, $oFeat, $oLook, $nSub, $nSubs, $big); 490 491 return $self->SUPER::out($fh) unless $self->{' read'}; 492 493# First sort the features 494 $i = 0; 495 foreach $t (sort grep {length($_) == 4 || m/\s_\d+$/o} %{$self->{'FEATURES'}}) 496 { 497 $self->{'FEATURES'}{$t}{'INDEX'} = $i++; 498 push (@tags, $t); 499 } 500 $self->{'FEATURES'}{'FEAT_TAGS'} = \@tags; 501 502 $base = $fh->tell(); 503 $fh->print(TTF_Pack("f", $self->{'Version'})); 504 $fh->print(pack("n3", 10, 0, 0)); 505 $oScript = $fh->tell() - $base; 506 @script = sort grep {length($_) == 4} keys %{$self->{'SCRIPTS'}}; 507 $fh->print(pack("n", $#script + 1)); 508 foreach $t (@script) 509 { $fh->print(pack("a4n", $t, 0)); } 510 511 $end = $fh->tell(); 512 foreach $t (@script) 513 { 514 $fh->seek($end, 0); 515 $tag = $self->{'SCRIPTS'}{$t}; 516 next if ($tag->{' REFTAG'}); 517 $tag->{' OFFSET'} = tell($fh) - $base - $oScript; 518 $fh->print(pack("n2", 0, $#{$tag->{'LANG_TAGS'}} + 1)); 519 foreach $lTag (sort @{$tag->{'LANG_TAGS'}}) 520 { $fh->print(pack("a4n", $lTag, 0)); } 521 foreach $lTag (@{$tag->{'LANG_TAGS'}}, 'DEFAULT') 522 { 523 $l = $tag->{$lTag}; 524 next if (!defined $l || $l->{' REFTAG'} ne ''); 525 $l->{' OFFSET'} = tell($fh) - $base - $oScript - $tag->{' OFFSET'}; 526 $fh->print(pack("n*", $l->{'RE_ORDER'}, defined $l->{'DEFAULT'} ? $l->{'DEFAULT'} : -1, 527 $#{$l->{'FEATURES'}} + 1, 528 map {$self->{'FEATURES'}{$_}{'INDEX'}} @{$l->{'FEATURES'}})); 529 } 530 $end = $fh->tell(); 531 if ($tag->{'DEFAULT'}{' REFTAG'} || defined $tag->{'DEFAULT'}{'FEATURES'}) 532 { 533 $fh->seek($base + $oScript + $tag->{' OFFSET'}, 0); 534 $off = $tag->{'DEFAULT'}{' REFTAG'} ? 535 $tag->{$tag->{'DEFAULT'}{' REFTAG'}}{' OFFSET'} : 536 $tag->{'DEFAULT'}{' OFFSET'}; 537 $fh->print(pack("n", $off)); 538 } 539 $fh->seek($base + $oScript + $tag->{' OFFSET'} + 4, 0); 540 foreach (sort @{$tag->{'LANG_TAGS'}}) 541 { 542 $off = $tag->{$_}{' REFTAG'} ? $tag->{$tag->{$_}{' REFTAG'}}{' OFFSET'} : 543 $tag->{$_}{' OFFSET'}; 544 $fh->print(pack("a4n", $_, $off)); 545 } 546 } 547 $fh->seek($base + $oScript + 2, 0); 548 foreach $t (@script) 549 { 550 $tag = $self->{'SCRIPTS'}{$t}; 551 $off = $tag->{' REFTAG'} ? $tag->{$tag->{' REFTAG'}}{' OFFSET'} : $tag->{' OFFSET'}; 552 $fh->print(pack("a4n", $t, $off)); 553 } 554 555 $fh->seek($end, 0); 556 $oFeat = $end - $base; 557 $nTags = $#{$self->{'FEATURES'}{'FEAT_TAGS'}} + 1; 558 $fh->print(pack("n", $nTags)); 559 $fh->print(pack("a4n", " ", 0) x $nTags); 560 561 foreach $t (@{$self->{'FEATURES'}{'FEAT_TAGS'}}) 562 { 563 $tag = $self->{'FEATURES'}{$t}; 564 $tag->{' OFFSET'} = tell($fh) - $base - $oFeat; 565 $fh->print(pack("n*", 0, $#{$tag->{'LOOKUPS'}} + 1, @{$tag->{'LOOKUPS'}})); 566 } 567 $end = $fh->tell(); 568 $fh->seek($oFeat + $base + 2, 0); 569 foreach $t (@{$self->{'FEATURES'}{'FEAT_TAGS'}}) 570 { $fh->print(pack("a4n", $t, $self->{'FEATURES'}{$t}{' OFFSET'})); } 571 572 undef $big; 573 $fh->seek($end, 0); 574 $oLook = $end - $base; 575 $nTags = $#{$self->{'LOOKUP'}} + 1; 576 $fh->print(pack("n", $nTags)); 577 $fh->print(pack("n", 0) x $nTags); 578 $end = $fh->tell(); 579 foreach $tag (@{$self->{'LOOKUP'}}) 580 { $nSubs += $self->num_sub($tag); } 581 for ($i = 0; $i < $nTags; $i++) 582 { 583 $fh->seek($end, 0); 584 $tag = $self->{'LOOKUP'}[$i]; 585 $tag->{' OFFSET'} = $end - $base - $oLook; 586 if (!defined $big && $tag->{' OFFSET'} + ($nTags - $i) * 6 + $nSubs * 10 > 65535) 587 { 588 my ($k, $ext); 589 $ext = $self->extension(); 590 $i--; 591 $tag = $self->{'LOOKUP'}[$i]; 592 $end = $tag->{' OFFSET'} + $base + $oLook; 593 $fh->seek($end, 0); 594 $big = $i; 595 for ($j = $i; $j < $nTags; $j++) 596 { 597 $tag = $self->{'LOOKUP'}[$j]; 598 $nSub = $self->num_sub($tag); 599 $fh->print(pack("nnn", $ext, $tag->{'FLAG'}, $nSub)); 600 $fh->print(pack("n*", map {$_ * 8 + 6 + $nSub * 2} (1 .. $nSub))); 601 $tag->{' EXT_OFFSET'} = $fh->tell(); 602 $tag->{' OFFSET'} = $tag->{' EXT_OFFSET'} - $nSub * 2 - 6 - $base - $oLook; 603 for ($k = 0; $k < $nSub; $k++) 604 { $fh->print(pack('nnN', 1, $tag->{'TYPE'}, 0)); } 605 } 606 $tag = $self->{'LOOKUP'}[$i]; 607 } 608 $nSub = $self->num_sub($tag); 609 if (!defined $big) 610 { 611 $fh->print(pack("nnn", $tag->{'TYPE'}, $tag->{'FLAG'}, $nSub)); 612 $fh->print(pack("n", 0) x $nSub); 613 } 614 else 615 { $end = $tag->{' EXT_OFFSET'}; } 616 @offs = (); 617 for ($j = 0; $j < $nSub; $j++) 618 { 619 push(@offs, tell($fh) - $end); 620 $self->out_sub($fh, $tag, $j); 621 } 622 $end = $fh->tell(); 623 if (!defined $big) 624 { 625 $fh->seek($tag->{' OFFSET'} + $base + $oLook + 6, 0); 626 $fh->print(pack("n*", @offs)); 627 } 628 else 629 { 630 $fh->seek($tag->{' EXT_OFFSET'}, 0); 631 for ($j = 0; $j < $nSub; $j++) 632 { $fh->print(pack('nnN', 1, $tag->{'TYPE'}, $offs[$j] - $j * 8)); } 633 } 634 } 635 $fh->seek($oLook + $base + 2, 0); 636 $fh->print(pack("n*", map {$self->{'LOOKUP'}[$_]{' OFFSET'}} (0 .. $nTags - 1))); 637 $fh->seek($base + 6, 0); 638 $fh->print(pack('n2', $oFeat, $oLook)); 639 $fh->seek($end, 0); 640 $self; 641} 642 643 644=head2 $t->num_sub($lookup) 645 646Asks the subclass to count the number of subtables for a particular lookup and to 647return that value. Used in out(). 648 649=cut 650 651sub num_sub 652{ 653 my ($self, $lookup) = @_; 654 655 return $#{$lookup->{'SUB'}} + 1; 656} 657 658 659=head2 $t->out_sub($fh, $lookup, $index) 660 661This stub is to allow subclasses to output subtables of lookups in a table specific manner. A 662reference to the lookup is passed in along with the subtable index. The file is located at the 663start of the subtable to be output 664 665=cut 666 667sub out_sub 668{ } 669 670 671=head1 Internal Functions & Methods 672 673Most of these methods are used by subclasses for handling such things as coverage 674tables. 675 676=head2 copy($ref) 677 678Internal function to copy the top level of a dictionary to create a new dictionary. 679Only the top level is copied. 680 681=cut 682 683sub copy 684{ 685 my ($ref) = @_; 686 my ($res) = {}; 687 688 foreach (keys %$ref) 689 { $res->{$_} = $ref->{$_}; } 690 $res; 691} 692 693 694=head2 $t->read_cover($cover_offset, $lookup_loc, $lookup, $fh, $is_cover) 695 696Reads a coverage table and stores the results in $lookup->{' CACHE'}, that is, if 697it hasn't been read already. 698 699=cut 700 701sub read_cover 702{ 703 my ($self, $offset, $base, $lookup, $fh, $is_cover) = @_; 704 my ($loc) = $fh->tell(); 705 my ($cover, $str); 706 707 return undef unless $offset; 708 $str = sprintf("%X", $base + $offset); 709 return $lookup->{' CACHE'}{$str} if defined $lookup->{' CACHE'}{$str}; 710 $fh->seek($base + $offset, 0); 711 $cover = PDF::API3::Compat::API2::Basic::TTF::Coverage->new($is_cover)->read($fh); 712 $fh->seek($loc, 0); 713 $lookup->{' CACHE'}{$str} = $cover; 714 return $cover; 715} 716 717 718=head2 ref_cache($obj, $cache, $offset) 719 720Internal function to keep track of the local positioning of subobjects such as 721coverage and class definition tables, and their offsets. 722What happens is that the cache is a hash of 723sub objects indexed by the reference (using a string mashing of the 724reference name which is valid for the duration of the reference) and holds a 725list of locations in the output string which should be filled in with the 726offset to the sub object when the final string is output in out_final. 727 728Uses tricks for Tie::Refhash 729 730=cut 731 732sub ref_cache 733{ 734 my ($obj, $cache, $offset) = @_; 735 736 return 0 unless defined $obj; 737 $cache->{"$obj"}[0] = $obj unless defined $cache->{"$obj"}; 738 push (@{$cache->{"$obj"}[1]}, $offset); 739 return 0; 740} 741 742 743=head2 out_final($fh, $out, $cache_list, $state) 744 745Internal function to actually output everything to the file handle given that 746now we know the offset to the first sub object to be output and which sub objects 747are to be output and what locations need to be updated, we can now 748generate everything. $cache_list is an array of two element arrays. The first element 749is a cache object, the second is an offset to be subtracted from each reference 750to that object made in the cache. 751 752If $state is 1, then the output is not sent to the filehandle and the return value 753is the string to be output. If $state is absent or 0 then output is not limited 754by storing in a string first and the return value is ""; 755 756=cut 757 758sub out_final 759{ 760 my ($fh, $out, $cache_list, $state) = @_; 761 my ($len) = length($out); 762 my ($base_loc) = $state ? 0 : $fh->tell(); 763 my ($loc, $t, $r, $s, $master_cache, $offs, $str); 764 765 $fh->print($out) unless $state; # first output the current attempt 766 foreach $r (@$cache_list) 767 { 768 $offs = $r->[1]; 769 foreach $t (sort keys %{$r->[0]}) 770 { 771 $str = "$t"; 772 if (!defined $master_cache->{$str}) 773 { 774 $master_cache->{$str} = ($state ? length($out) : $fh->tell()) 775 - $base_loc; 776 if ($state) 777 { $out .= $r->[0]{$str}[0]->out($fh, 1); } 778 else 779 { $r->[0]{$str}[0]->out($fh, 0); } 780 } 781 foreach $s (@{$r->[0]{$str}[1]}) 782 { substr($out, $s, 2) = pack('n', $master_cache->{$str} - $offs); } 783 } 784 } 785 if ($state) 786 { return $out; } 787 else 788 { 789 $loc = $fh->tell(); 790 $fh->seek($base_loc, 0); 791 $fh->print($out); # the corrected version 792 $fh->seek($loc, 0); 793 } 794} 795 796 797=head2 $self->read_context($lookup, $fh, $type, $fmt, $cover, $count, $loc) 798 799Internal method to read context (simple and chaining context) lookup subtables for 800the GSUB and GPOS table types. The assumed values for $type correspond to those 801for GSUB, so GPOS should adjust the values upon calling. 802 803=cut 804 805sub read_context 806{ 807 my ($self, $lookup, $fh, $type, $fmt, $cover, $count, $loc) = @_; 808 my ($dat, $i, $s, $t, @subst, @srec, $mcount, $scount); 809 810 if ($type == 5 && $fmt < 3) 811 { 812 if ($fmt == 2) 813 { 814 $fh->read($dat, 2); 815 $lookup->{'CLASS'} = $self->read_cover($count, $loc, $lookup, $fh, 0); 816 $count = TTF_Unpack('S', $dat); 817 } 818 $fh->read($dat, $count << 1); 819 foreach $s (TTF_Unpack('S*', $dat)) 820 { 821 if ($s == 0) 822 { 823 push (@{$lookup->{'RULES'}}, []); 824 next; 825 } 826 @subst = (); 827 $fh->seek($loc + $s, 0); 828 $fh->read($dat, 2); 829 $t = TTF_Unpack('S', $dat); 830 $fh->read($dat, $t << 1); 831 foreach $t (TTF_Unpack('S*', $dat)) 832 { 833 $fh->seek($loc + $s + $t, 0); 834 @srec = (); 835 $fh->read($dat, 4); 836 ($mcount, $scount) = TTF_Unpack('S2', $dat); 837 $mcount--; 838 $fh->read($dat, ($mcount << 1) + ($scount << 2)); 839 for ($i = 0; $i < $scount; $i++) 840 { push (@srec, [TTF_Unpack('S2', substr($dat, 841 ($mcount << 1) + ($i << 2), 4))]); } 842 push (@subst, {'ACTION' => [@srec], 843 'MATCH' => [TTF_Unpack('S*', 844 substr($dat, 0, $mcount << 1))]}); 845 } 846 push (@{$lookup->{'RULES'}}, [@subst]); 847 } 848 $lookup->{'ACTION_TYPE'} = 'l'; 849 $lookup->{'MATCH_TYPE'} = ($fmt == 2 ? 'c' : 'g'); 850 } elsif ($type == 5 && $fmt == 3) 851 { 852 $fh->read($dat, ($cover << 1) + ($count << 2)); 853 @subst = (); @srec = (); 854 for ($i = 0; $i < $cover; $i++) 855 { push (@subst, $self->read_cover(TTF_Unpack('S', substr($dat, $i << 1, 2)), 856 $loc, $lookup, $fh, 1)); } 857 for ($i = 0; $i < $count; $i++) 858 { push (@srec, [TTF_Unpack('S2', substr($dat, ($count << 1) + ($i << 2), 4))]); } 859 $lookup->{'RULES'} = [[{'ACTION' => [@srec], 'MATCH' => [@subst]}]]; 860 $lookup->{'ACTION_TYPE'} = 'l'; 861 $lookup->{'MATCH_TYPE'} = 'o'; 862 } elsif ($type == 6 && $fmt < 3) 863 { 864 if ($fmt == 2) 865 { 866 $fh->read($dat, 6); 867 $lookup->{'PRE_CLASS'} = $self->read_cover($count, $loc, $lookup, $fh, 0) if $count; 868 ($i, $mcount, $count) = TTF_Unpack('S3', $dat); # messy: 2 classes & count 869 $lookup->{'CLASS'} = $self->read_cover($i, $loc, $lookup, $fh, 0) if $i; 870 $lookup->{'POST_CLASS'} = $self->read_cover($mcount, $loc, $lookup, $fh, 0) if $mcount; 871 } 872 $fh->read($dat, $count << 1); 873 foreach $s (TTF_Unpack('S*', $dat)) 874 { 875 if ($s == 0) 876 { 877 push (@{$lookup->{'RULES'}}, []); 878 next; 879 } 880 @subst = (); 881 $fh->seek($loc + $s, 0); 882 $fh->read($dat, 2); 883 $t = TTF_Unpack('S', $dat); 884 $fh->read($dat, $t << 1); 885 foreach $i (TTF_Unpack('S*', $dat)) 886 { 887 $fh->seek($loc + $s + $i, 0); 888 @srec = (); 889 $t = {}; 890 $fh->read($dat, 2); 891 $mcount = TTF_Unpack('S', $dat); 892 if ($mcount > 0) 893 { 894 $fh->read($dat, $mcount << 1); 895 $t->{'PRE'} = [TTF_Unpack('S*', $dat)]; 896 } 897 $fh->read($dat, 2); 898 $mcount = TTF_Unpack('S', $dat); 899 if ($mcount > 1) 900 { 901 $fh->read($dat, ($mcount - 1) << 1); 902 $t->{'MATCH'} = [TTF_Unpack('S*', $dat)]; 903 } 904 $fh->read($dat, 2); 905 $mcount = TTF_Unpack('S', $dat); 906 if ($mcount > 0) 907 { 908 $fh->read($dat, $mcount << 1); 909 $t->{'POST'} = [TTF_Unpack('S*', $dat)]; 910 } 911 $fh->read($dat, 2); 912 $scount = TTF_Unpack('S', $dat); 913 $fh->read($dat, $scount << 2); 914 for ($i = 0; $i < $scount; $i++) 915 { push (@srec, [TTF_Unpack('S2', substr($dat, $i << 2))]); } 916 $t->{'ACTION'} = [@srec]; 917 push (@subst, $t); 918 } 919 push (@{$lookup->{'RULES'}}, [@subst]); 920 } 921 $lookup->{'ACTION_TYPE'} = 'l'; 922 $lookup->{'MATCH_TYPE'} = ($fmt == 2 ? 'c' : 'g'); 923 } elsif ($type == 6 && $fmt == 3) 924 { 925 $t = {}; 926 unless ($cover == 0) 927 { 928 @subst = (); 929 $fh->read($dat, $cover << 1); 930 foreach $s (TTF_Unpack('S*', $dat)) 931 { push(@subst, $self->read_cover($s, $loc, $lookup, $fh, 1)); } 932 $t->{'PRE'} = [@subst]; 933 } 934 $fh->read($dat, 2); 935 $count = TTF_Unpack('S', $dat); 936 unless ($count == 0) 937 { 938 @subst = (); 939 $fh->read($dat, $count << 1); 940 foreach $s (TTF_Unpack('S*', $dat)) 941 { push(@subst, $self->read_cover($s, $loc, $lookup, $fh, 1)); } 942 $t->{'MATCH'} = [@subst]; 943 } 944 $fh->read($dat, 2); 945 $count = TTF_Unpack('S', $dat); 946 unless ($count == 0) 947 { 948 @subst = (); 949 $fh->read($dat, $count << 1); 950 foreach $s (TTF_Unpack('S*', $dat)) 951 { push(@subst, $self->read_cover($s, $loc, $lookup, $fh, 1)); } 952 $t->{'POST'} = [@subst]; 953 } 954 $fh->read($dat, 2); 955 $count = TTF_Unpack('S', $dat); 956 @subst = (); 957 $fh->read($dat, $count << 2); 958 for ($i = 0; $i < $count; $i++) 959 { push (@subst, [TTF_Unpack('S2', substr($dat, $i << 2, 4))]); } 960 $t->{'ACTION'} = [@subst]; 961 $lookup->{'RULES'} = [[$t]]; 962 $lookup->{'ACTION_TYPE'} = 'l'; 963 $lookup->{'MATCH_TYPE'} = 'o'; 964 } 965 $lookup; 966} 967 968 969=head2 $self->out_context($lookup, $fh, $type, $fmt, $ctables, $out, $num) 970 971Provides shared behaviour between GSUB and GPOS tables during output for context 972(chained and simple) rules. In addition, support is provided here for type 4 GSUB 973tables, which are not used in GPOS. The value for $type corresponds to the type 974in a GSUB table so calling from GPOS should adjust the value accordingly. 975 976=cut 977 978sub out_context 979{ 980 my ($self, $lookup, $fh, $type, $fmt, $ctables, $out, $num) = @_; 981 my ($offc, $offd, $i, $j, $r, $t, $numd); 982 983 if (($type == 4 || $type == 5 || $type == 6) && ($fmt == 1 || $fmt == 2)) 984 { 985 my ($base_off); 986 987 if ($fmt == 1) 988 { 989 $out = pack("nnn", $fmt, PDF::API3::Compat::API2::Basic::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2), 990 $num); 991 $base_off = 6; 992 } elsif ($type == 5) 993 { 994 $out = pack("nnnn", $fmt, PDF::API3::Compat::API2::Basic::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2), 995 PDF::API3::Compat::API2::Basic::TTF::Ttopen::ref_cache($lookup->{'CLASS'}, $ctables, 4), $num); 996 $base_off = 8; 997 } elsif ($type == 6) 998 { 999 $out = pack("n6", $fmt, PDF::API3::Compat::API2::Basic::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2), 1000 PDF::API3::Compat::API2::Basic::TTF::Ttopen::ref_cache($lookup->{'PRE_CLASS'}, $ctables, 4), 1001 PDF::API3::Compat::API2::Basic::TTF::Ttopen::ref_cache($lookup->{'CLASS'}, $ctables, 6), 1002 PDF::API3::Compat::API2::Basic::TTF::Ttopen::ref_cache($lookup->{'POST_CLASS'}, $ctables, 8), 1003 $num); 1004 $base_off = 12; 1005 } 1006 1007 $out .= pack('n*', (0) x $num); 1008 $offc = length($out); 1009 for ($i = 0; $i < $num; $i++) 1010 { 1011 $r = $lookup->{'RULES'}[$i]; 1012 next unless exists $r->[0]{'ACTION'}; 1013 $numd = $#{$r} + 1; 1014 substr($out, ($i << 1) + $base_off, 2) = pack('n', $offc); 1015 $out .= pack('n*', $numd, (0) x $numd); 1016 $offd = length($out) - $offc; 1017 for ($j = 0; $j < $numd; $j++) 1018 { 1019 substr($out, $offc + 2 + ($j << 1), 2) = pack('n', $offd); 1020 if ($type == 4) 1021 { 1022 $out .= pack('n*', $r->[$j]{'ACTION'}[0], $#{$r->[$j]{'MATCH'}} + 2, 1023 @{$r->[$j]{'MATCH'}}); 1024 } elsif ($type == 5) 1025 { 1026 $out .= pack('n*', $#{$r->[$j]{'MATCH'}} + 2, 1027 $#{$r->[$j]{'ACTION'}} + 1, 1028 @{$r->[$j]{'MATCH'}}); 1029 foreach $t (@{$r->[$j]{'ACTION'}}) 1030 { $out .= pack('n2', @$t); } 1031 } elsif ($type == 6) 1032 { 1033 $out .= pack('n*', $#{$r->[$j]{'PRE'}} + 1, @{$r->[$j]{'PRE'}}, 1034 $#{$r->[$j]{'MATCH'}} + 2, @{$r->[$j]{'MATCH'}}, 1035 $#{$r->[$j]{'POST'}} + 1, @{$r->[$j]{'POST'}}, 1036 $#{$r->[$j]{'ACTION'}} + 1); 1037 foreach $t (@{$r->[$j]{'ACTION'}}) 1038 { $out .= pack('n2', @$t); } 1039 } 1040 $offd = length($out) - $offc; 1041 } 1042 $offc = length($out); 1043 } 1044 } elsif ($type == 5 && $fmt == 3) 1045 { 1046 $out .= pack('n3', $fmt, $#{$lookup->{'RULES'}[0][0]{'MATCH'}} + 1, 1047 $#{$lookup->{'RULES'}[0][0]{'ACTION'}} + 1); 1048 foreach $t (@{$lookup->{'RULES'}[0][0]{'MATCH'}}) 1049 { $out .= pack('n', PDF::API3::Compat::API2::Basic::TTF::Ttopen::ref_cache($t, $ctables, length($out))); } 1050 foreach $t (@{$lookup->{'RULES'}[0][0]{'ACTION'}}) 1051 { $out .= pack('n2', @$t); } 1052 } elsif ($type == 6 && $fmt == 3) 1053 { 1054 $r = $lookup->{'RULES'}[0][0]; 1055 $out .= pack('n2', $fmt, $#{$r->{'PRE'}} + 1); 1056 foreach $t (@{$r->{'PRE'}}) 1057 { $out .= PDF::API3::Compat::API2::Basic::TTF::Ttopen::ref_cache($t, $ctables, length($out)); } 1058 $out .= pack('n', $#{$r->{'MATCH'}} + 1); 1059 foreach $t (@{$r->{'MATCH'}}) 1060 { $out .= PDF::API3::Compat::API2::Basic::TTF::Ttopen::ref_cache($t, $ctables, length($out)); } 1061 $out .= pack('n', $#{$r->{'POST'}} + 1); 1062 foreach $t (@{$r->{'POST'}}) 1063 { $out .= PDF::API3::Compat::API2::Basic::TTF::Ttopen::ref_cache($t, $ctables, length($out)); } 1064 $out .= pack('n', $#{$r->{'ACTION'}} + 1); 1065 foreach $t (@{$r->{'ACTION'}}) 1066 { $out .= pack('n2', @$t); } 1067 } 1068 $out; 1069} 1070 1071=head1 BUGS 1072 1073=over 4 1074 1075=item * 1076 1077No way to share cachable items (coverage tables, classes, anchors, device tables) 1078across different lookups. The items are always output after the lookup and 1079repeated if necessary. Within lookup sharing is possible. 1080 1081=back 1082 1083=head1 AUTHOR 1084 1085Martin Hosken Martin_Hosken@sil.org. See L<PDF::API3::Compat::API2::Basic::TTF::Font> for copyright and 1086licensing. 1087 1088=cut 1089 10901; 1091 1092