src/librarian/font-optimizer/ext/Font-TTF/lib/Font/TTF/GPOS.pm

   1 package Font::TTF::GPOS;
   2
   3 =head1 NAME
   4
   5 Font::TTF::GPOS - Support for Opentype GPOS tables in conjunction with TTOpen
   6
   7 =head1 DESCRIPTION
   8
   9 The GPOS table is one of the most complicated tables in the TTF spec and the
  10 corresponding data structure abstraction is also not trivial. While much of the
  11 structure of a GPOS is shared with a GSUB table via the L<Font::TTF::Ttopen>
  12
  13 =head1 INSTANCE VARIABLES
  14
  15 Here we describe the additions and lookup specific information for GPOS tables.
  16 Unfortunately there is no one abstraction which seems to work comfortable for
  17 all GPOS tables, so we will also examine how the variables are used for different
  18 lookup types.
  19
  20 The following are the values allowed in the ACTION_TYPE and MATCH_TYPE variables:
  21
  22 =over 4
  23
  24 =item ACTION_TYPE
  25
  26 This can take any of the following values
  27
  28 =over 8
  29
  30 =item a
  31
  32 The ACTION is an array of anchor tables
  33
  34 =item o
  35
  36 Offset. There is no RULE array. The ADJUST variable contains a value record (see
  37 later in this description)
  38
  39 =item v
  40
  41 The ACTION is a value record.
  42
  43 =item p
  44
  45 Pair adjustment. The ACTION contains an array of two value records for the matched
  46 two glyphs.
  47
  48 =item e
  49
  50 Exit and Entry records. The ACTION contains an array of two anchors corresponding
  51 to the exit and entry anchors for the glyph.
  52
  53 =item l
  54
  55 Indicates a lookup based contextual rule as per the GSUB table.
  56
  57 =back
  58
  59 =item MATCH_TYPE
  60
  61 This can take any of the following values
  62
  63 =over 8
  64
  65 =item g
  66
  67 A glyph array
  68
  69 =item c
  70
  71 An array of class values
  72
  73 =item o
  74
  75 An array of coverage tables
  76
  77 =back
  78
  79 =back
  80
  81 The following variables are added for Attachment Positioning Subtables:
  82
  83 =over 4
  84
  85 =item MATCH
  86
  87 This contains an array of glyphs to match against for all RULES. It is much like
  88 having the same MATCH string in all RULES. In the cases it is used so far, it only
  89 ever contains one element.
  90
  91 =item MARKS
  92
  93 This contains a Mark array consisting of each element being a subarray of two
  94 elements:
  95
  96 =over 8
  97
  98 =item CLASS
  99
 100 The class that this mark uses on its base
 101
 102 =item ANCHOR
 103
 104 The anchor with which to attach this mark glyph
 105
 106 =back
 107
 108 The base table for mark to base, ligature or mark attachment positioning is
 109 structured with the ACTION containing an array of anchors corresponding to each
 110 attachment class. For ligatures, there is more than one RULE in the RULE array
 111 corresponding to each glyph in the coverage table.
 112
 113 =back
 114
 115 Other variables which are provided for informational purposes are:
 116
 117 =over 4
 118
 119 =item VFMT
 120
 121 Value format for the adjustment of the glyph matched by the coverage table.
 122
 123 =item VFMT2
 124
 125 Value format used in pair adjustment for the second glyph in the pair
 126
 127 =back
 128
 129 =head2 Value Records
 130
 131 There is a subtype used in GPOS tables called a value record. It is used to adjust
 132 the position of a glyph from its default position. The value record is variable
 133 length with a bitfield at the beginning to indicate which of the following
 134 entries are included. The bitfield is not stored since it is recalculated at
 135 write time.
 136
 137 =over 4
 138
 139 =item XPlacement
 140
 141 Horizontal adjustment for placement (not affecting other unattached glyphs)
 142
 143 =item YPlacement
 144
 145 Vertical adjustment for placement (not affecting other unattached glyphs)
 146
 147 =item XAdvance
 148
 149 Adjust the advance width glyph (used only in horizontal writing systems)
 150
 151 =item YAdvance
 152
 153 Adjust the vertical advance (used only in vertical writing systems)
 154
 155 =item XPlaDevice
 156
 157 Device table for device specific adjustment of horizontal placement
 158
 159 =item YPlaDevice
 160
 161 Device table for device specific adjustment of vertical placement
 162
 163 =item XAdvDevice
 164
 165 Device table for device specific adjustment of horizontal advance
 166
 167 =item YAdDevice
 168
 169 Device table for device specific adjustment of vertical advance
 170
 171 =item XIdPlacement
 172
 173 Horizontal placement metric id (for Multiple Master fonts - but that's all I know!)
 174
 175 =item YIdPlacement
 176
 177 Vertical placement metric id
 178
 179 =item XIdAdvance
 180
 181 Horizontal advance metric id
 182
 183 =item YIdAdvance
 184
 185 Vertical advance metric id
 186
 187 =back
 188
 189 =head1 CORRESPONDANCE TO LAYOUT TYPES
 190
 191 Here is what is stored in the ACTION_TYPE and MATCH_TYPE for each of the known
 192 GPOS subtable types:
 193
 194                 1.1 1.2 2.1 2.2 3   4   5   6   7.1 7.2 7.3 8.1 8.2 8.3
 195   ACTION_TYPE    o   v   p   p  e   a   a   a    l   l   l   l   l   l
 196   MATCH_TYPE             g   c                   g   c   o   g   c   o
 197
 198
 199 =head1 METHODS
 200
 201 =cut
 202
 203 use strict;
 204 use Font::TTF::Ttopen;
 205 use Font::TTF::Delta;
 206 use Font::TTF::Anchor;
 207 use Font::TTF::Utils;
 208 use vars qw(@ISA);
 209
 210 @ISA = qw(Font::TTF::Ttopen);
 211
 212
 213 =head2 read_sub
 214
 215 Reads the subtable into the data structures
 216
 217 =cut
 218
 219 sub read_sub
 220 {
 221     my ($self, $fh, $main_lookup, $sindex) = @_;
 222     my ($type) = $main_lookup->{'TYPE'};
 223     my ($loc) = $fh->tell();
 224     my ($lookup) = $main_lookup->{'SUB'}[$sindex];
 225     my ($dat, $mcount, $scount, $i, $j, $count, $fmt, $fmt2, $cover, $srec, $subst);
 226     my ($c1, $c2, $s, $moff, $boff);
 227
 228
 229     if ($type == 8)
 230     {
 231         $fh->read($dat, 4);
 232         ($fmt, $cover) = TTF_Unpack('S2', $dat);
 233         if ($fmt < 3)
 234         {
 235             $fh->read($dat, 2);
 236             $count = TTF_Unpack('S', $dat);
 237         }
 238     } else
 239     {
 240         $fh->read($dat, 6);
 241         ($fmt, $cover, $count) = TTF_Unpack("S3", $dat);
 242     }
 243     unless ($fmt == 3 && ($type == 7 || $type == 8))
 244     { $lookup->{'COVERAGE'} = $self->read_cover($cover, $loc, $lookup, $fh, 1); }
 245
 246     $lookup->{'FORMAT'} = $fmt;
 247     if ($type == 1 && $fmt == 1)
 248     {
 249         $lookup->{'VFMT'} = $count;
 250         $lookup->{'ADJUST'} = $self->read_value($count, $loc, $lookup, $fh);
 251         $lookup->{'ACTION_TYPE'} = 'o';
 252     } elsif ($type == 1 && $fmt == 2)
 253     {
 254         $lookup->{'VFMT'} = $count;
 255         $fh->read($dat, 2);
 256         $mcount = unpack('n', $dat);
 257         for ($i = 0; $i < $mcount; $i++)
 258         { push (@{$lookup->{'RULES'}}, [{'ACTION' =>
 259                                     [$self->read_value($count, $loc, $lookup, $fh)]}]); }
 260         $lookup->{'ACTION_TYPE'} = 'v';
 261     } elsif ($type == 2 && $fmt == 1)
 262     {
 263         $lookup->{'VFMT'} = $count;
 264         $fh->read($dat, 4);
 265         ($fmt2, $mcount) = unpack('n2', $dat);
 266         $lookup->{'VFMT2'} = $fmt2;
 267         $fh->read($dat, $mcount << 1);
 268         foreach $s (unpack('n*', $dat))
 269         {
 270             $fh->seek($loc + $s, 0);
 271             $fh->read($dat, 2);
 272             $scount = TTF_Unpack('S', $dat);
 273             $subst = [];
 274             for ($i = 0; $i < $scount; $i++)
 275             {
 276                 $srec = {};
 277                 $fh->read($dat, 2);
 278                 $srec->{'MATCH'} = [TTF_Unpack('S', $dat)];
 279                 $srec->{'ACTION'} = [$self->read_value($count, $loc, $lookup, $fh),
 280                                      $self->read_value($fmt2, $loc, $lookup, $fh)];
 281                 push (@$subst, $srec);
 282             }
 283             push (@{$lookup->{'RULES'}}, $subst);
 284         }
 285         $lookup->{'ACTION_TYPE'} = 'p';
 286         $lookup->{'MATCH_TYPE'} = 'g';
 287     } elsif ($type == 2 && $fmt == 2)
 288     {
 289         $fh->read($dat, 10);
 290         ($lookup->{'VFMT2'}, $c1, $c2, $mcount, $scount) = TTF_Unpack('S*', $dat);
 291         $lookup->{'CLASS'} = $self->read_cover($c1, $loc, $lookup, $fh, 0);
 292         $lookup->{'MATCH'} = [$self->read_cover($c2, $loc, $lookup, $fh, 0)];
 293         $lookup->{'VFMT'} = $count;
 294         for ($i = 0; $i < $mcount; $i++)
 295         {
 296             $subst = [];
 297             for ($j = 0; $j < $scount; $j++)
 298             {
 299                 $srec = {};
 300                 $srec->{'ACTION'} = [$self->read_value($lookup->{'VFMT'}, $loc, $lookup, $fh),
 301                                      $self->read_value($lookup->{'VFMT2'}, $loc, $lookup, $fh)];
 302                 push (@$subst, $srec);
 303             }
 304             push (@{$lookup->{'RULES'}}, $subst);
 305         }
 306         $lookup->{'ACTION_TYPE'} = 'p';
 307         $lookup->{'MATCH_TYPE'} = 'c';
 308     } elsif ($type == 3 && $fmt == 1)
 309     {
 310         $fh->read($dat, $count << 2);
 311         for ($i = 0; $i < $count; $i++)
 312         { push (@{$lookup->{'RULES'}}, [{'ACTION' =>
 313                 [$self->read_anchor(TTF_Unpack('S', substr($dat, $i << 2, 2)),
 314                         $loc, $lookup, $fh),
 315                  $self->read_anchor(TTF_Unpack('S', substr($dat, ($i << 2) + 2, 2)),
 316                         $loc, $lookup, $fh)]}]); }
 317         $lookup->{'ACTION_TYPE'} = 'e';
 318     } elsif ($type == 4 || $type == 5 || $type == 6)
 319     {
 320         my (@offs, $mloc, $thisloc, $ncomp, $k);
 321
 322         $lookup->{'MATCH'} = [$lookup->{'COVERAGE'}];
 323         $lookup->{'COVERAGE'} = $self->read_cover($count, $loc, $lookup, $fh, 1);
 324         $fh->read($dat, 6);
 325         ($mcount, $moff, $boff) = TTF_Unpack('S*', $dat);
 326         $fh->seek($loc + $moff, 0);
 327         $fh->read($dat, 2);
 328         $count = TTF_Unpack('S', $dat);
 329         for ($i = 0; $i < $count; $i++)
 330         {
 331             $fh->read($dat, 4);
 332             push (@{$lookup->{'MARKS'}}, [TTF_Unpack('S', $dat),
 333                     $self->read_anchor(TTF_Unpack('S', substr($dat, 2, 2)) + $moff,
 334                             $loc, $lookup, $fh)]);
 335         }
 336         $fh->seek($loc + $boff, 0);
 337         $fh->read($dat, 2);
 338         $count = TTF_Unpack('S', $dat);
 339         $mloc = $fh->tell() - 2;
 340         $thisloc = $mloc;
 341         if ($type == 5)
 342         {
 343             $fh->read($dat, $count << 1);
 344             @offs = TTF_Unpack('S*', $dat);
 345         }
 346         for ($i = 0; $i < $count; $i++)
 347         {
 348             if ($type == 5)
 349             {
 350                 $thisloc = $mloc + $offs[$i];
 351                 $fh->seek($thisloc, 0);
 352                 $fh->read($dat, 2);
 353                 $ncomp = TTF_Unpack('S', $dat);
 354             } else
 355             { $ncomp = 1; }
 356             for ($j = 0; $j < $ncomp; $j++)
 357             {
 358                 $subst = [];
 359                 $fh->read($dat, $mcount << 1);
 360                 for ($k = 0; $k < $mcount; $k++)
 361                 { push (@$subst, $self->read_anchor(TTF_Unpack('S', substr($dat, $k << 1, 2)) + $thisloc - $loc,
 362                         $loc, $lookup, $fh)); }
 363
 364                 push (@{$lookup->{'RULES'}[$i]}, {'ACTION' => $subst});
 365             }
 366         }
 367         $lookup->{'ACTION_TYPE'} = 'a';
 368     } elsif ($type == 7 || $type == 8)
 369     { $self->read_context($lookup, $fh, $type - 2, $fmt, $cover, $count, $loc); }
 370     $lookup;
 371 }
 372
 373
 374 =head2 $t->extension
 375
 376 Returns the table type number for the extension table
 377
 378 =cut
 379
 380 sub extension
 381 { return 9; }
 382
 383
 384 =head2 $t->out_sub
 385
 386 Outputs the subtable to the given filehandle
 387
 388 =cut
 389
 390 sub out_sub
 391 {
 392     my ($self, $fh, $main_lookup, $index, $ctables, $base) = @_;
 393     my ($type) = $main_lookup->{'TYPE'};
 394     my ($lookup) = $main_lookup->{'SUB'}[$index];
 395     my ($fmt) = $lookup->{'FORMAT'};
 396     my ($out, $r, $s, $t, $i, $j, $vfmt, $vfmt2, $loc1);
 397     my ($num) = $#{$lookup->{'RULES'}} + 1;
 398     my ($mtables) = {};
 399     my (@reftables);
 400
 401     if ($type == 1 && $fmt == 1)
 402     {
 403         $out = pack('n2', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base));
 404         $vfmt = $self->fmt_value($lookup->{'ADJUST'});
 405         $out .= pack('n', $vfmt) . $self->out_value($lookup->{'ADJUST'}, $vfmt, $ctables, 6 + $base);
 406     } elsif ($type == 1 && $fmt == 2)
 407     {
 408         $vfmt = 0;
 409         foreach $r (@{$lookup->{'RULES'}})
 410         { $vfmt |= $self->fmt_value($r->[0]{'ACTION'}[0]); }
 411         $out = pack('n4', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
 412                             $vfmt, $#{$lookup->{'RULES'}} + 1);
 413         foreach $r (@{$lookup->{'RULES'}})
 414         { $out .= $self->out_value($r->[0]{'ACTION'}[0], $vfmt, $ctables, length($out) + $base); }
 415     } elsif ($type == 2 && $fmt < 3)
 416     {
 417         $vfmt = 0;
 418         $vfmt2 = 0;
 419         foreach $r (@{$lookup->{'RULES'}})
 420         {
 421             foreach $t (@$r)
 422             {
 423                 $vfmt |= $self->fmt_value($t->{'ACTION'}[0]);
 424                 $vfmt2 |= $self->fmt_value($t->{'ACTION'}[1]);
 425             }
 426         }
 427         if ($fmt == 1)
 428         {
 429             # start PairPosFormat1 subtable
 430             $out = pack('n5',
 431                         $fmt,
 432                         Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
 433                         $vfmt,
 434                         $vfmt2,
 435                         $#{$lookup->{'RULES'}} + 1); # PairSetCount
 436             my $off = 0;
 437             $off += length($out);
 438             $off += 2 * ($#{$lookup->{'RULES'}} + 1); # there will be PairSetCount offsets here
 439             my $pairsets = '';
 440             my (%cache);
 441             foreach $r (@{$lookup->{'RULES'}}) # foreach PairSet table
 442             {
 443                 # write offset to this PairSet at end of PairPosFormat1 table
 444                 if (defined $cache{"$r"})
 445                 { $out .= pack('n', $cache{"$r"}); }
 446                 else
 447                 {
 448                     $out .= pack('n', $off);
 449                     $cache{"$r"} = $off;
 450
 451                     # generate PairSet itself (using $off as eventual offset within PairPos subtable)
 452                     my $pairset = pack('n', $#{$r} + 1); # PairValueCount
 453                     foreach $t (@$r) # foreach PairValueRecord
 454                     {
 455                         $pairset .= pack('n', $t->{'MATCH'}[0]); # SecondGlyph - MATCH has only one entry
 456                         $pairset .=
 457                             $self->out_value($t->{'ACTION'}[0], $vfmt,  $ctables, $off + length($pairset) + $base);
 458                         $pairset .=
 459                             $self->out_value($t->{'ACTION'}[1], $vfmt2, $ctables, $off + length($pairset) + $base);
 460                     }
 461                     $off += length($pairset);
 462                     $pairsets .= $pairset;
 463                 }
 464             }
 465             $out .= $pairsets;
 466             die "internal error: PairPos size not as calculated" if (length($out) != $off);
 467         } else
 468         {
 469             $out = pack('n8', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
 470                             $vfmt, $vfmt2,
 471                             Font::TTF::Ttopen::ref_cache($lookup->{'CLASS'}, $ctables, 8 + $base),
 472                             Font::TTF::Ttopen::ref_cache($lookup->{'MATCH'}[0], $ctables, 10 + $base),
 473                             $lookup->{'CLASS'}{'max'} + 1, $lookup->{'MATCH'}[0]{'max'} + 1);
 474
 475             for ($i = 0; $i <= $lookup->{'CLASS'}{'max'}; $i++)
 476             {
 477                 for ($j = 0; $j <= $lookup->{'MATCH'}[0]{'max'}; $j++)
 478                 {
 479                     $out .= $self->out_value($lookup->{'RULES'}[$i][$j]{'ACTION'}[0], $vfmt, $ctables, length($out) + $base);
 480                     $out .= $self->out_value($lookup->{'RULES'}[$i][$j]{'ACTION'}[1], $vfmt2, $ctables, length($out) + $base);
 481                 }
 482             }
 483         }
 484     } elsif ($type == 3 && $fmt == 1)
 485     {
 486         $out = pack('n3', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
 487                             $#{$lookup->{'RULES'}} + 1);
 488         foreach $r (@{$lookup->{'RULES'}})
 489         {
 490             $out .= pack('n2', Font::TTF::Ttopen::ref_cache($r->[0]{'ACTION'}[0], $ctables, length($out) + $base),
 491                             Font::TTF::Ttopen::ref_cache($r->[0]{'ACTION'}[1], $ctables, length($out) + 2 + $base));
 492         }
 493     } elsif ($type == 4 || $type == 5 || $type == 6)
 494     {
 495         my ($loc_off, $loc_t, $ltables);
 496
 497         $out = pack('n7', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'MATCH'}[0], $ctables, 2 + $base),
 498                             Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 4 + $base),
 499                             $#{$lookup->{'RULES'}[0][0]{'ACTION'}} + 1, 12, ($#{$lookup->{'MARKS'}} + 4) << 2,
 500                             $#{$lookup->{'MARKS'}} + 1);
 501         foreach $r (@{$lookup->{'MARKS'}})
 502         { $out .= pack('n2', $r->[0], Font::TTF::Ttopen::ref_cache($r->[1], $mtables, length($out) + 2)); }
 503         push (@reftables, [$mtables, 12]);
 504
 505         $loc_t = length($out);
 506         substr($out, 10, 2) = pack('n', $loc_t);
 507         $out .= pack('n', $#{$lookup->{'RULES'}} + 1);
 508         if ($type == 5)
 509         {
 510             $loc1 = length($out);
 511             $out .= pack('n*', (0) x ($#{$lookup->{'RULES'}} + 1));
 512         }
 513         $ltables = {};
 514         for ($i = 0; $i <= $#{$lookup->{'RULES'}}; $i++)
 515         {
 516             if ($type == 5)
 517             {
 518                 $ltables = {};
 519                 $loc_t = length($out);
 520                 substr($out, $loc1 + ($i << 1), 2) = TTF_Pack('S', $loc_t - $loc1 + 2);
 521             }
 522
 523             $r = $lookup->{'RULES'}[$i];
 524             $out .= pack('n', $#{$r} + 1) if ($type == 5);
 525             foreach $t (@$r)
 526             {
 527                 foreach $s (@{$t->{'ACTION'}})
 528                 { $out .= pack('n', Font::TTF::Ttopen::ref_cache($s, $ltables, length($out))); }
 529             }
 530             push (@reftables, [$ltables, $loc_t]) if ($type == 5);
 531         }
 532         push (@reftables, [$ltables, $loc_t]) unless ($type == 5);
 533         $out = Font::TTF::Ttopen::out_final($fh, $out, \@reftables, 1);
 534     } elsif ($type == 7 || $type == 8)
 535     { $out = $self->out_context($lookup, $fh, $type - 2, $fmt, $ctables, $out, $num, $base); }
 536 #    push (@reftables, [$ctables, 0]);
 537     $out;
 538 }
 539
 540
 541 =head2 $t->read_value($format, $base, $lookup, $fh)
 542
 543 Reads a value record from the current location in the file, according to the
 544 format given.
 545
 546 =cut
 547
 548 sub read_value
 549 {
 550     my ($self, $fmt, $base, $lookup, $fh) = @_;
 551     my ($flag) = 1;
 552     my ($res) = {};
 553     my ($s, $i, $dat);
 554
 555     $s = 0;
 556     for ($i = 0; $i < 12; $i++)
 557     {
 558         $s++ if ($flag & $fmt);
 559         $flag <<= 1;
 560     }
 561
 562     $fh->read($dat, $s << 1);
 563     $flag = 1; $i = 0;
 564     foreach $s (qw(XPlacement YPlacement XAdvance YAdvance))
 565     {
 566         $res->{$s} = TTF_Unpack('s', substr($dat, $i++ << 1, 2)) if ($fmt & $flag);
 567         $flag <<= 1;
 568     }
 569
 570     foreach $s (qw(XPlaDevice YPlaDevice XAdvDevice YAdvDevice))
 571     {
 572         if ($fmt & $flag)
 573         { $res->{$s} = $self->read_delta(TTF_Unpack('S', substr($i++ << 1, 2)),
 574                             $base, $lookup, $fh); }
 575         $flag <<= 1;
 576     }
 577
 578     foreach $s (qw(XIdPlacement YIdPlacement XIdAdvance YIdAdvance))
 579     {
 580         $res->{$s} = TTF_Unpack('S', substr($dat, $i++ << 1, 2)) if ($fmt & $flag);
 581         $flag <<= 1;
 582     }
 583     $res;
 584 }
 585
 586
 587 =head2 $t->read_delta($offset, $base, $lookup, $fh)
 588
 589 Reads a delta (device table) at the given offset if it hasn't already been read.
 590 Store the offset and item in the lookup cache ($lookup->{' CACHE'})
 591
 592 =cut
 593
 594 sub read_delta
 595 {
 596     my ($self, $offset, $base, $lookup, $fh) = @_;
 597     my ($loc) = $fh->tell();
 598     my ($res, $str);
 599
 600     return undef unless $offset;
 601     $str = sprintf("%X", $base + $offset);
 602     return $lookup->{' CACHE'}{$str} if defined $lookup->{' CACHE'}{$str};
 603     $fh->seek($base + $offset, 0);
 604     $res = Font::TTF::Delta->new->read($fh);
 605     $fh->seek($loc, 0);
 606     $lookup->{' CACHE'}{$str} = $res;
 607     return $res;
 608 }
 609
 610
 611 =head2 $t->read_anchor($offset, $base, $lookup, $fh)
 612
 613 Reads an Anchor table at the given offset if it hasn't already been read.
 614
 615 =cut
 616
 617 sub read_anchor
 618 {
 619     my ($self, $offset, $base, $lookup, $fh) = @_;
 620     my ($loc) = $fh->tell();
 621     my ($res, $str);
 622
 623     return undef unless $offset;
 624     $str = sprintf("%X", $base + $offset);
 625     return $lookup->{' CACHE'}{$str} if defined $lookup->{' CACHE'}{$str};
 626     $fh->seek($base + $offset, 0);
 627     $res = Font::TTF::Anchor->new->read($fh);
 628     $fh->seek($loc, 0);
 629     $lookup->{' CACHE'}{$str} = $res;
 630     return $res;
 631 }
 632
 633
 634 =head2 $t->fmt_value
 635
 636 Returns the value format for a given value record
 637
 638 =cut
 639
 640 sub fmt_value
 641 {
 642     my ($self, $value) = @_;
 643     my ($fmt) = 0;
 644     my ($n);
 645
 646     foreach $n (reverse qw(XPlacement YPlacement XAdvance YAdvance XPlaDevice YPlaDevice
 647                   XAdvDevice YAdvDevice XIdPlacement YIdPlacement XIdAdvance
 648                   YIdAdvance))
 649     {
 650         $fmt <<= 1;
 651         $fmt |= 1 if (defined $value->{$n} && (ref $value->{$n} || $value->{$n}));
 652     }
 653     $fmt;
 654 }
 655
 656
 657 =head2 $t->out_value
 658
 659 Returns the output string for the outputting of the value for a given format. Also
 660 updates the offset cache for any device tables referenced.
 661
 662 =cut
 663
 664 sub out_value
 665 {
 666     my ($self, $value, $fmt, $tables, $offset) = @_;
 667     my ($n, $flag, $out);
 668
 669     $flag = 1;
 670     foreach $n (qw(XPlacement YPlacement XAdvance YAdvance))
 671     {
 672         $out .= pack('n', $value->{$n}) if ($flag & $fmt);
 673         $flag <<= 1;
 674     }
 675     foreach $n (qw(XPlaDevice YPlaDevice XAdvDevice YAdvDevice))
 676     {
 677         if ($flag & $fmt)
 678         {
 679             $out .= pack('n', Font::TTF::Ttopen::ref_cache(
 680                         $value->{$n}, $tables, $offset + length($out)));
 681         }
 682         $flag <<= 1;
 683     }
 684     foreach $n (qw(XIdPlacement YIdPlacement XIdAdvance YIdAdvance))
 685     {
 686         $out .= pack('n', $value->{$n}) if ($flag & $fmt);
 687         $flag <<= 1;
 688     }
 689     $out;
 690 }
 691
 692
 693 =head1 AUTHOR
 694
 695 Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
 696 licensing.
 697
 698 =cut
 699
 700 1;
 701