librarian/font-optimizer/ext/Font-TTF/lib/Font/TTF/OldMort.pm

   1 package Font::TTF::OldMort;
   2
   3 =head1 NAME
   4
   5 Font::TTF::OldMort - Glyph Metamorphosis table in a font
   6
   7 =head1 DESCRIPTION
   8
   9 =head1 INSTANCE VARIABLES
  10
  11 =item version
  12
  13 table version number (Fixed: currently 1.0)
  14
  15 =item chains
  16
  17 list of metamorphosis chains, each of which has its own fields:
  18
  19 =over
  20
  21 =item defaultFlags
  22
  23 chain's default subfeature flags (UInt32)
  24
  25 =item featureEntries
  26
  27 list of feature entries, each of which has fields:
  28
  29 =over
  30
  31 =item type
  32
  33 =item setting
  34
  35 =item enable
  36
  37 =item disable
  38
  39 =back
  40
  41 =item subtables
  42
  43 list of metamorphosis subtables, each of which has fields:
  44
  45 =over
  46
  47 =item type
  48
  49 subtable type (0: rearrangement; 1: contextual substitution; 2: ligature;
  50 4: non-contextual substitution; 5: insertion)
  51
  52 =item direction
  53
  54 processing direction ('LR' or 'RL')
  55
  56 =item orientation
  57
  58 applies to text in which orientation ('VH', 'V', or 'H')
  59
  60 =item subFeatureFlags
  61
  62 the subfeature flags controlling whether the table is used (UInt32)
  63
  64 =back
  65
  66 Further fields depend on the type of subtable:
  67
  68 =over
  69
  70 Rearrangement table:
  71
  72 =over
  73
  74 =item classes
  75
  76 array of lists of glyphs
  77
  78 =item states
  79
  80 array of arrays of hashes{'nextState', 'flags'}
  81
  82 =back
  83
  84 Contextual substitution table:
  85
  86 =over
  87
  88 =item classes
  89
  90 array of lists of glyphs
  91
  92 =item states
  93
  94 array of array of hashes{'nextState', 'flags', 'actions'}, where C<actions>
  95 is an array of two elements which are offsets to be added to [marked, current]
  96 glyph to get index into C<mappings> (or C<undef> if no mapping to be applied)
  97
  98 =item mappings
  99
 100 list of glyph codes mapped to through the state table mappings
 101
 102 =back
 103
 104 Ligature table:
 105
 106 Non-contextual substitution table:
 107
 108 Insertion table:
 109
 110 =back
 111
 112 =back
 113
 114 =head1 METHODS
 115
 116 =cut
 117
 118 use strict;
 119 use vars qw(@ISA);
 120 use Font::TTF::Utils;
 121 use Font::TTF::AATutils;
 122 use IO::File;
 123
 124 @ISA = qw(Font::TTF::Table);
 125
 126 =head2 $t->read
 127
 128 Reads the table into memory
 129
 130 =cut
 131
 132 sub read
 133 {
 134     my ($self) = @_;
 135     my ($dat, $fh, $numChains);
 136
 137     $self->SUPER::read or return $self;
 138
 139     $fh = $self->{' INFILE'};
 140
 141     $fh->read($dat, 8);
 142     ($self->{'version'}, $numChains) = TTF_Unpack("fL", $dat);
 143
 144     my $chains = [];
 145     foreach (1 .. $numChains) {
 146         my $chainStart = $fh->tell();
 147         $fh->read($dat, 12);
 148         my ($defaultFlags, $chainLength, $nFeatureEntries, $nSubtables) = TTF_Unpack("LLSS", $dat);
 149         my $featureEntries = [];
 150         foreach (1 .. $nFeatureEntries) {
 151             $fh->read($dat, 12);
 152             my ($featureType, $featureSetting, $enableFlags, $disableFlags) = TTF_Unpack("SSLL", $dat);
 153             push @$featureEntries,    {
 154                                         'type'        => $featureType,
 155                                         'setting'    => $featureSetting,
 156                                         'enable'    => $enableFlags,
 157                                         'disable'    => $disableFlags
 158                                     };
 159         }
 160         my $subtables = [];
 161         foreach (1 .. $nSubtables) {
 162             my $subtableStart = $fh->tell();
 163             $fh->read($dat, 8);
 164             my ($length, $coverage, $subFeatureFlags) = TTF_Unpack("SSL", $dat);
 165             my $type = $coverage & 0x0007;
 166
 167             my $subtable =    {
 168                                 'type'                => $type,
 169                                 'direction'            => (($coverage & 0x4000) ? 'RL' : 'LR'),
 170                                 'orientation'        => (($coverage & 0x2000) ? 'VH' : ($coverage & 0x8000) ? 'V' : 'H'),
 171                                 'subFeatureFlags'    => $subFeatureFlags
 172                             };
 173
 174             if ($type == 0) {    # rearrangement
 175                 my ($classes, $states) = AAT_read_state_table($fh, 0);
 176                 $subtable->{'classes'} = $classes;
 177                 $subtable->{'states'} = $states;
 178             }
 179
 180             elsif ($type == 1) {    # contextual
 181                 my $stateTableStart = $fh->tell();
 182                 my ($classes, $states, $entries) = AAT_read_state_table($fh, 2);
 183
 184                 $fh->seek($stateTableStart, IO::File::SEEK_SET);
 185                 $fh->read($dat, 10);
 186                 my ($stateSize, $classTable, $stateArray, $entryTable, $mappingTables) = unpack("nnnnn", $dat);
 187                 my $limits = [$classTable, $stateArray, $entryTable, $mappingTables, $length - 8];
 188
 189                 foreach (@$entries) {
 190                     my $actions = $_->{'actions'};
 191                     foreach (@$actions) {
 192                         $_ = $_ ? $_ - ($mappingTables / 2) : undef;
 193                     }
 194                 }
 195
 196                 $subtable->{'classes'} = $classes;
 197                 $subtable->{'states'} = $states;
 198                 $subtable->{'mappings'} = [unpack("n*", AAT_read_subtable($fh, $stateTableStart, $mappingTables, $limits))];
 199             }
 200
 201             elsif ($type == 2) {    # ligature
 202                 my $stateTableStart = $fh->tell();
 203                 my ($classes, $states, $entries) = AAT_read_state_table($fh, 0);
 204
 205                 $fh->seek($stateTableStart, IO::File::SEEK_SET);
 206                 $fh->read($dat, 14);
 207                 my ($stateSize, $classTable, $stateArray, $entryTable,
 208                     $ligActionTable, $componentTable, $ligatureTable) = unpack("nnnnnnn", $dat);
 209                 my $limits = [$classTable, $stateArray, $entryTable, $ligActionTable, $componentTable, $ligatureTable, $length - 8];
 210
 211                 my %actions;
 212                 my $actionLists;
 213                 foreach (@$entries) {
 214                     my $offset = $_->{'flags'} & 0x3fff;
 215                     $_->{'flags'} &= ~0x3fff;
 216                     if ($offset != 0) {
 217                         if (not defined $actions{$offset}) {
 218                             $fh->seek($stateTableStart + $offset, IO::File::SEEK_SET);
 219                             my $actionList;
 220                             while (1) {
 221                                 $fh->read($dat, 4);
 222                                 my $action = unpack("N", $dat);
 223                                 my ($last, $store, $component) = (($action & 0x80000000) != 0, ($action & 0xC0000000) != 0, ($action & 0x3fffffff));
 224                                 $component -= 0x40000000 if $component > 0x1fffffff;
 225                                 $component -= $componentTable / 2;
 226                                 push @$actionList, { 'store' => $store, 'component' => $component };
 227                                 last if $last;
 228                             }
 229                             push @$actionLists, $actionList;
 230                             $actions{$offset} = $#$actionLists;
 231                         }
 232                         $_->{'actions'} = $actions{$offset};
 233                     }
 234                 }
 235
 236                 $subtable->{'componentTable'} = $componentTable;
 237                 my $components = [unpack("n*", AAT_read_subtable($fh, $stateTableStart, $componentTable, $limits))];
 238                 foreach (@$components) {
 239                     $_ = ($_ - $ligatureTable) . " +" if $_ >= $ligatureTable;
 240                 }
 241                 $subtable->{'components'} = $components;
 242
 243                 $subtable->{'ligatureTable'} = $ligatureTable;
 244                 $subtable->{'ligatures'} = [unpack("n*", AAT_read_subtable($fh, $stateTableStart, $ligatureTable, $limits))];
 245
 246                 $subtable->{'classes'} = $classes;
 247                 $subtable->{'states'} = $states;
 248                 $subtable->{'actionLists'} = $actionLists;
 249             }
 250
 251             elsif ($type == 4) {    # non-contextual
 252                 my ($format, $lookup) = AAT_read_lookup($fh, 2, $length - 8, undef);
 253                 $subtable->{'format'} = $format;
 254                 $subtable->{'lookup'} = $lookup;
 255             }
 256
 257             elsif ($type == 5) {    # insertion
 258                 my $stateTableStart = $fh->tell();
 259                 my ($classes, $states, $entries) = AAT_read_state_table($fh, 2);
 260
 261                 my %insertListHash;
 262                 my $insertLists;
 263                 foreach (@$entries) {
 264                     my $flags = $_->{'flags'};
 265                     my @insertCount = (($flags & 0x03e0) >> 5, ($flags & 0x001f));
 266                     my $actions = $_->{'actions'};
 267                     foreach (0 .. 1) {
 268                         if ($insertCount[$_] > 0) {
 269                             $fh->seek($stateTableStart + $actions->[$_], IO::File::SEEK_SET);
 270                             $fh->read($dat, $insertCount[$_] * 2);
 271                             if (not defined $insertListHash{$dat}) {
 272                                 push @$insertLists, [unpack("n*", $dat)];
 273                                 $insertListHash{$dat} = $#$insertLists;
 274                             }
 275                             $actions->[$_] = $insertListHash{$dat};
 276                         }
 277                         else {
 278                             $actions->[$_] = undef;
 279                         }
 280                     }
 281                 }
 282
 283                 $subtable->{'classes'} = $classes;
 284                 $subtable->{'states'} = $states;
 285                 $subtable->{'insertLists'} = $insertLists;
 286             }
 287
 288             else {
 289                 die "unknown subtable type";
 290             }
 291
 292             push @$subtables, $subtable;
 293             $fh->seek($subtableStart + $length, IO::File::SEEK_SET);
 294         }
 295
 296         push @$chains,    {
 297                             'defaultFlags'        => $defaultFlags,
 298                             'featureEntries'    => $featureEntries,
 299                             'subtables'            => $subtables
 300                         };
 301         $fh->seek($chainStart + $chainLength, IO::File::SEEK_SET);
 302     }
 303
 304     $self->{'chains'} = $chains;
 305
 306     $self;
 307 }
 308
 309 =head2 $t->out($fh)
 310
 311 Writes the table to a file either from memory or by copying
 312
 313 =cut
 314
 315 sub out
 316 {
 317     my ($self, $fh) = @_;
 318
 319     return $self->SUPER::out($fh) unless $self->{' read'};
 320
 321     my $chains = $self->{'chains'};
 322     $fh->print(TTF_Pack("fL", $self->{'version'}, scalar @$chains));
 323
 324     foreach (@$chains) {
 325         my $chainStart = $fh->tell();
 326         my ($featureEntries, $subtables) = ($_->{'featureEntries'}, $_->{'subtables'});
 327         $fh->print(TTF_Pack("LLSS", $_->{'defaultFlags'}, 0, scalar @$featureEntries, scalar @$subtables)); # placeholder for length
 328
 329         foreach (@$featureEntries) {
 330             $fh->print(TTF_Pack("SSLL", $_->{'type'}, $_->{'setting'}, $_->{'enable'}, $_->{'disable'}));
 331         }
 332
 333         foreach (@$subtables) {
 334             my $subtableStart = $fh->tell();
 335             my $type = $_->{'type'};
 336             my $coverage = $type;
 337             $coverage += 0x4000 if $_->{'direction'} eq 'RL';
 338             $coverage += 0x2000 if $_->{'orientation'} eq 'VH';
 339             $coverage += 0x8000 if $_->{'orientation'} eq 'V';
 340
 341             $fh->print(TTF_Pack("SSL", 0, $coverage, $_->{'subFeatureFlags'}));    # placeholder for length
 342
 343             if ($type == 0) {    # rearrangement
 344                 AAT_write_state_table($fh, $_->{'classes'}, $_->{'states'}, 0);
 345             }
 346
 347             elsif ($type == 1) {    # contextual
 348                 my $stHeader = $fh->tell();
 349                 $fh->print(pack("nnnnn", (0) x 5));    # placeholders for stateSize, classTable, stateArray, entryTable, mappingTables
 350
 351                 my $classTable = $fh->tell() - $stHeader;
 352                 my $classes = $_->{'classes'};
 353                 AAT_write_classes($fh, $classes);
 354
 355                 my $stateArray = $fh->tell() - $stHeader;
 356                 my $states = $_->{'states'};
 357                 my ($stateSize, $entries) = AAT_write_states($fh, $classes, $stateArray, $states,
 358                         sub {
 359                             my $actions = $_->{'actions'};
 360                             ( $_->{'flags'}, @$actions )
 361                         }
 362                     );
 363
 364                 my $entryTable = $fh->tell() - $stHeader;
 365                 my $offset = ($entryTable + 8 * @$entries) / 2;
 366                 foreach (@$entries) {
 367                     my ($nextState, $flags, @parts) = split /,/;
 368                     $fh->print(pack("nnnn", $nextState, $flags, map { $_ eq "" ? 0 : $_ + $offset } @parts));
 369                 }
 370
 371                 my $mappingTables = $fh->tell() - $stHeader;
 372                 my $mappings = $_->{'mappings'};
 373                 $fh->print(pack("n*", @$mappings));
 374
 375                 my $loc = $fh->tell();
 376                 $fh->seek($stHeader, IO::File::SEEK_SET);
 377                 $fh->print(pack("nnnnn", $stateSize, $classTable, $stateArray, $entryTable, $mappingTables));
 378                 $fh->seek($loc, IO::File::SEEK_SET);
 379             }
 380
 381             elsif ($type == 2) {    # ligature
 382                 my $stHeader = $fh->tell();
 383                 $fh->print(pack("nnnnnnn", (0) x 7));    # placeholders for stateSize, classTable, stateArray, entryTable, actionLists, components, ligatures
 384
 385                 my $classTable = $fh->tell() - $stHeader;
 386                 my $classes = $_->{'classes'};
 387                 AAT_write_classes($fh, $classes);
 388
 389                 my $stateArray = $fh->tell() - $stHeader;
 390                 my $states = $_->{'states'};
 391
 392                 my ($stateSize, $entries) = AAT_write_states($fh, $classes, $stateArray, $states,
 393                         sub {
 394                             ( $_->{'flags'} & 0xc000, $_->{'actions'} )
 395                         }
 396                     );
 397
 398                 my $actionLists = $_->{'actionLists'};
 399                 my %actionListOffset;
 400                 my $actionListDataLength = 0;
 401                 my @actionListEntries;
 402                 foreach (0 .. $#$entries) {
 403                     my ($nextState, $flags, $offset) = split(/,/, $entries->[$_]);
 404                     if ($offset eq "") {
 405                         $offset = undef;
 406                     }
 407                     else {
 408                         if (defined $actionListOffset{$offset}) {
 409                             $offset = $actionListOffset{$offset};
 410                         }
 411                         else {
 412                             $actionListOffset{$offset} = $actionListDataLength;
 413                             my $list = $actionLists->[$offset];
 414                             $actionListDataLength += 4 * @$list;
 415                             push @actionListEntries, $list;
 416                             $offset = $actionListOffset{$offset};
 417                         }
 418                     }
 419                     $entries->[$_] = [ $nextState, $flags, $offset ];
 420                 }
 421                 my $entryTable = $fh->tell() - $stHeader;
 422                 my $ligActionLists = ($entryTable + @$entries * 4 + 3) & ~3;
 423                 foreach (@$entries) {
 424                     $_->[2] += $ligActionLists if defined $_->[2];
 425                     $fh->print(pack("nn", $_->[0], $_->[1] + $_->[2]));
 426                 }
 427                 $fh->print(pack("C*", (0) x ($ligActionLists - $entryTable - @$entries * 4)));
 428
 429                 die "internal error" if $fh->tell() != $ligActionLists + $stHeader;
 430
 431                 my $componentTable = $fh->tell() - $stHeader + $actionListDataLength;
 432                 my $actionList;
 433                 foreach $actionList (@actionListEntries) {
 434                     foreach (0 .. $#$actionList) {
 435                         my $action = $actionList->[$_];
 436                         my $val = $action->{'component'} + $componentTable / 2;
 437                         $val += 0x40000000 if $val < 0;
 438                         $val &= 0x3fffffff;
 439                         $val |= 0x40000000 if $action->{'store'};
 440                         $val |= 0x80000000 if $_ == $#$actionList;
 441                         $fh->print(pack("N", $val));
 442                     }
 443                 }
 444
 445                 die "internal error" if $fh->tell() != $componentTable + $stHeader;
 446
 447                 my $components = $_->{'components'};
 448                 my $ligatureTable = $componentTable + @$components * 2;
 449                 $fh->print(pack("n*", map { (index($_, '+') >= 0 ? $ligatureTable : 0) + $_ } @$components));
 450
 451                 my $ligatures = $_->{'ligatures'};
 452                 $fh->print(pack("n*", @$ligatures));
 453
 454                 my $loc = $fh->tell();
 455                 $fh->seek($stHeader, IO::File::SEEK_SET);
 456                 $fh->print(pack("nnnnnnn", $stateSize, $classTable, $stateArray, $entryTable, $ligActionLists, $componentTable, $ligatureTable));
 457                 $fh->seek($loc, IO::File::SEEK_SET);
 458             }
 459
 460             elsif ($type == 4) {    # non-contextual
 461                 AAT_write_lookup($fh, $_->{'format'}, $_->{'lookup'}, 2, undef);
 462             }
 463
 464             elsif ($type == 5) {    # insertion
 465             }
 466
 467             else {
 468                 die "unknown subtable type";
 469             }
 470
 471             my $length = $fh->tell() - $subtableStart;
 472             my $padBytes = (4 - ($length & 3)) & 3;
 473             $fh->print(pack("C*", (0) x $padBytes));
 474             $length += $padBytes;
 475             $fh->seek($subtableStart, IO::File::SEEK_SET);
 476             $fh->print(pack("n", $length));
 477             $fh->seek($subtableStart + $length, IO::File::SEEK_SET);
 478         }
 479
 480         my $chainLength = $fh->tell() - $chainStart;
 481         $fh->seek($chainStart + 4, IO::File::SEEK_SET);
 482         $fh->print(pack("N", $chainLength));
 483         $fh->seek($chainStart + $chainLength, IO::File::SEEK_SET);
 484     }
 485 }
 486
 487 =head2 $t->print($fh)
 488
 489 Prints a human-readable representation of the table
 490
 491 =cut
 492
 493 sub print
 494 {
 495     my ($self, $fh) = @_;
 496
 497     $self->read;
 498     my $feat = $self->{' PARENT'}->{'feat'};
 499     $feat->read;
 500     my $post = $self->{' PARENT'}->{'post'};
 501     $post->read;
 502
 503     $fh = 'STDOUT' unless defined $fh;
 504
 505     $fh->printf("version %f\n", $self->{'version'});
 506
 507     my $chains = $self->{'chains'};
 508     foreach (@$chains) {
 509         my $defaultFlags = $_->{'defaultFlags'};
 510         $fh->printf("chain: defaultFlags = %08x\n", $defaultFlags);
 511
 512         my $featureEntries = $_->{'featureEntries'};
 513         foreach (@$featureEntries) {
 514             $fh->printf("\tfeature %d, setting %d : enableFlags = %08x, disableFlags = %08x # '%s: %s'\n",
 515                         $_->{'type'}, $_->{'setting'}, $_->{'enable'}, $_->{'disable'},
 516                         $feat->settingName($_->{'type'}, $_->{'setting'}));
 517         }
 518
 519         my $subtables = $_->{'subtables'};
 520         foreach (@$subtables) {
 521             my $type = $_->{'type'};
 522             my $subFeatureFlags = $_->{'subFeatureFlags'};
 523             $fh->printf("\n\t%s table, %s, %s, subFeatureFlags = %08x # %s (%s)\n",
 524                         subtable_type_($type), $_->{'direction'}, $_->{'orientation'}, $subFeatureFlags,
 525                         "Default " . ((($subFeatureFlags & $defaultFlags) != 0) ? "On" : "Off"),
 526                         join(", ",
 527                             map {
 528                                 join(": ", $feat->settingName($_->{'type'}, $_->{'setting'}) )
 529                             } grep { ($_->{'enable'} & $subFeatureFlags) != 0 } @$featureEntries
 530                         ) );
 531
 532             if ($type == 0) {    # rearrangement
 533                 print_classes_($fh, $_, $post);
 534
 535                 $fh->print("\n");
 536                 my $states = $_->{'states'};
 537                 my @verbs = (    "0", "Ax->xA", "xD->Dx", "AxD->DxA",
 538                                 "ABx->xAB", "ABx->xBA", "xCD->CDx", "xCD->DCx",
 539                                 "AxCD->CDxA", "AxCD->DCxA", "ABxD->DxAB", "ABxD->DxBA",
 540                                 "ABxCD->CDxAB", "ABxCD->CDxBA", "ABxCD->DCxAB", "ABxCD->DCxBA");
 541                 foreach (0 .. $#$states) {
 542                     $fh->printf("\t\tState %d:", $_);
 543                     my $state = $states->[$_];
 544                     foreach (@$state) {
 545                         my $flags;
 546                         $flags .= "!" if ($_->{'flags'} & 0x4000);
 547                         $flags .= "<" if ($_->{'flags'} & 0x8000);
 548                         $flags .= ">" if ($_->{'flags'} & 0x2000);
 549                         $fh->printf("\t(%s%d,%s)", $flags, $_->{'nextState'}, $verbs[($_->{'flags'} & 0x000f)]);
 550                     }
 551                     $fh->print("\n");
 552                 }
 553             }
 554
 555             elsif ($type == 1) {    # contextual
 556                 print_classes_($fh, $_, $post);
 557
 558                 $fh->print("\n");
 559                 my $states = $_->{'states'};
 560                 foreach (0 .. $#$states) {
 561                     $fh->printf("\t\tState %d:", $_);
 562                     my $state = $states->[$_];
 563                     foreach (@$state) {
 564                         my $flags;
 565                         $flags .= "!" if ($_->{'flags'} & 0x4000);
 566                         $flags .= "*" if ($_->{'flags'} & 0x8000);
 567                         my $actions = $_->{'actions'};
 568                         $fh->printf("\t(%s%d,%s,%s)", $flags, $_->{'nextState'}, map { defined $_ ? $_ : "=" } @$actions);
 569                     }
 570                     $fh->print("\n");
 571                 }
 572
 573                 $fh->print("\n");
 574                 my $mappings = $_->{'mappings'};
 575                 foreach (0 .. $#$mappings) {
 576                     $fh->printf("\t\tMapping %d: %d [%s]\n", $_, $mappings->[$_], $post->{'VAL'}[$mappings->[$_]]);
 577                 }
 578             }
 579
 580             elsif ($type == 2) {    # ligature
 581                 print_classes_($fh, $_, $post);
 582
 583                 $fh->print("\n");
 584                 my $states = $_->{'states'};
 585                 foreach (0 .. $#$states) {
 586                     $fh->printf("\t\tState %d:", $_);
 587                     my $state = $states->[$_];
 588                     foreach (@$state) {
 589                         my $flags;
 590                         $flags .= "!" if ($_->{'flags'} & 0x4000);
 591                         $flags .= "*" if ($_->{'flags'} & 0x8000);
 592                         $fh->printf("\t(%s%d,%s)", $flags, $_->{'nextState'}, defined $_->{'actions'} ? $_->{'actions'} : "=");
 593                     }
 594                     $fh->print("\n");
 595                 }
 596
 597                 $fh->print("\n");
 598                 my $actionLists = $_->{'actionLists'};
 599                 foreach (0 .. $#$actionLists) {
 600                     $fh->printf("\t\tList %d:\t", $_);
 601                     my $actionList = $actionLists->[$_];
 602                     $fh->printf("%s\n", join(", ", map { ($_->{'component'} . ($_->{'store'} ? "*" : "") ) } @$actionList));
 603                 }
 604
 605                 my $ligatureTable = $_->{'ligatureTable'};
 606
 607                 $fh->print("\n");
 608                 my $components = $_->{'components'};
 609                 foreach (0 .. $#$components) {
 610                     $fh->printf("\t\tComponent %d: %s\n", $_, $components->[$_]);
 611                 }
 612
 613                 $fh->print("\n");
 614                 my $ligatures = $_->{'ligatures'};
 615                 foreach (0 .. $#$ligatures) {
 616                     $fh->printf("\t\tLigature %d: %d [%s]\n", $_, $ligatures->[$_], $post->{'VAL'}[$ligatures->[$_]]);
 617                 }
 618             }
 619
 620             elsif ($type == 4) {    # non-contextual
 621                 my $lookup = $_->{'lookup'};
 622                 $fh->printf("\t\tLookup format %d\n", $_->{'format'});
 623                 if (defined $lookup) {
 624                     foreach (sort { $a <=> $b } keys %$lookup) {
 625                         $fh->printf("\t\t\t%d [%s] -> %d [%s])\n", $_, $post->{'VAL'}[$_], $lookup->{$_}, $post->{'VAL'}[$lookup->{$_}]);
 626                     }
 627                 }
 628             }
 629
 630             elsif ($type == 5) {    # insertion
 631                 print_classes_($fh, $_, $post);
 632
 633                 $fh->print("\n");
 634                 my $states = $_->{'states'};
 635                 foreach (0 .. $#$states) {
 636                     $fh->printf("\t\tState %d:", $_);
 637                     my $state = $states->[$_];
 638                     foreach (@$state) {
 639                         my $flags;
 640                         $flags .= "!" if ($_->{'flags'} & 0x4000);
 641                         $flags .= "*" if ($_->{'flags'} & 0x8000);
 642                         my $actions = $_->{'actions'};
 643                         $fh->printf("\t(%s%d,%s,%s)", $flags, $_->{'nextState'}, map { defined $_ ? $_ : "=" } @$actions);
 644                     }
 645                     $fh->print("\n");
 646                 }
 647
 648                 $fh->print("\n");
 649                 my $insertLists = $_->{'insertLists'};
 650                 foreach (0 .. $#$insertLists) {
 651                     my $insertList = $insertLists->[$_];
 652                     $fh->printf("\t\tList %d: %s\n", $_, join(", ", map { $_ . " [" . $post->{'VAL'}[$_] . "]" } @$insertList));
 653                 }
 654             }
 655
 656             else {
 657                 # unknown
 658             }
 659         }
 660     }
 661 }
 662
 663 sub print_classes_
 664 {
 665     my ($fh, $subtable, $post) = @_;
 666
 667     my $classes = $subtable->{'classes'};
 668     foreach (0 .. $#$classes) {
 669         my $class = $classes->[$_];
 670         if (defined $class) {
 671             $fh->printf("\t\tClass %d:\t%s\n", $_, join(", ", map { $_ . " [" . $post->{'VAL'}[$_] . "]" } @$class));
 672         }
 673     }
 674 }
 675
 676 sub subtable_type_
 677 {
 678     my ($val) = @_;
 679     my ($res);
 680
 681     my @types =    (
 682                     'Rearrangement',
 683                     'Contextual',
 684                     'Ligature',
 685                     undef,
 686                     'Non-contextual',
 687                     'Insertion',
 688                 );
 689     $res = $types[$val] or ('Undefined (' . $val . ')');
 690
 691     $res;
 692 }
 693
 694 1;
 695
 696 =head1 BUGS
 697
 698 None known
 699
 700 =head1 AUTHOR
 701
 702 Jonathan Kew L<Jonathan_Kew@sil.org>. See L<Font::TTF::Font> for copyright and
 703 licensing.
 704
 705 =cut
 706