X-Git-Url: https://git.mdrn.pl/librarian.git/blobdiff_plain/2ada86c7bb585d419b95c95ce42d5b7a9fa45475..fefdce4e24f9e397df5538fe6e7f54b5ece4d841:/src/librarian/font-optimizer/ext/Font-TTF/lib/Font/TTF/Kern/Subtable.pm
diff --git a/src/librarian/font-optimizer/ext/Font-TTF/lib/Font/TTF/Kern/Subtable.pm b/src/librarian/font-optimizer/ext/Font-TTF/lib/Font/TTF/Kern/Subtable.pm
new file mode 100644
index 0000000..b1db410
--- /dev/null
+++ b/src/librarian/font-optimizer/ext/Font-TTF/lib/Font/TTF/Kern/Subtable.pm
@@ -0,0 +1,175 @@
+package Font::TTF::Kern::Subtable;
+
+=head1 NAME
+
+Font::TTF::Kern::Subtable - Kern Subtable superclass for AAT
+
+=head1 METHODS
+
+=cut
+
+use strict;
+use Font::TTF::Utils;
+use Font::TTF::AATutils;
+use IO::File;
+
+require Font::TTF::Kern::OrderedList;
+require Font::TTF::Kern::StateTable;
+require Font::TTF::Kern::ClassArray;
+require Font::TTF::Kern::CompactClassArray;
+
+sub new
+{
+ my ($class) = @_;
+ my ($self) = {};
+
+ $class = ref($class) || $class;
+
+ bless $self, $class;
+}
+
+sub create
+{
+ my ($class, $type, $coverage, $length) = @_;
+
+ $class = ref($class) || $class;
+
+ my $subclass;
+ if ($type == 0) {
+ $subclass = 'Font::TTF::Kern::OrderedList';
+ }
+ elsif ($type == 1) {
+ $subclass = 'Font::TTF::Kern::StateTable';
+ }
+ elsif ($type == 2) {
+ $subclass = 'Font::TTF::Kern::ClassArray';
+ }
+ elsif ($type == 3) {
+ $subclass = 'Font::TTF::Kern::CompactClassArray';
+ }
+
+ my @options;
+ push @options,'vertical' if ($coverage & 0x8000) != 0;
+ push @options,'crossStream' if ($coverage & 0x4000) != 0;
+ push @options,'variation' if ($coverage & 0x2000) != 0;
+
+ my ($subTable) = $subclass->new(@options);
+
+ map { $subTable->{$_} = 1 } @options;
+
+ $subTable->{'type'} = $type;
+ $subTable->{'length'} = $length;
+
+ $subTable;
+}
+
+=head2 $t->out($fh)
+
+Writes the table to a file
+
+=cut
+
+sub out
+{
+ my ($self, $fh) = @_;
+
+ my $subtableStart = $fh->tell();
+ my $type = $self->{'type'};
+ my $coverage = $type;
+ $coverage += 0x8000 if $self->{'vertical'};
+ $coverage += 0x4000 if $self->{'crossStream'};
+ $coverage += 0x2000 if $self->{'variation'};
+
+ $fh->print(TTF_Pack("LSS", 0, $coverage, $self->{'tupleIndex'})); # placeholder for length
+
+ $self->out_sub($fh);
+
+ my $length = $fh->tell() - $subtableStart;
+ my $padBytes = (4 - ($length & 3)) & 3;
+ $fh->print(pack("C*", (0) x $padBytes));
+ $length += $padBytes;
+ $fh->seek($subtableStart, IO::File::SEEK_SET);
+ $fh->print(pack("N", $length));
+ $fh->seek($subtableStart + $length, IO::File::SEEK_SET);
+}
+
+=head2 $t->print($fh)
+
+Prints a human-readable representation of the table
+
+=cut
+
+sub post
+{
+ my ($self) = @_;
+
+ my $post = $self->{' PARENT'}{' PARENT'}{'post'};
+ if (defined $post) {
+ $post->read;
+ }
+ else {
+ $post = {};
+ }
+
+ return $post;
+}
+
+sub print
+{
+ my ($self, $fh) = @_;
+
+ my $post = $self->post();
+ $fh = 'STDOUT' unless defined $fh;
+}
+
+=head2 $t->print_classes($fh)
+
+Prints a human-readable representation of the table
+
+=cut
+
+sub print_classes
+{
+ my ($self, $fh) = @_;
+
+ my $post = $self->post();
+
+ my $classes = $self->{'classes'};
+ foreach (0 .. $#$classes) {
+ my $class = $classes->[$_];
+ if (defined $class) {
+ $fh->printf("\t\tClass %d:\t%s\n", $_, join(", ", map { $_ . " [" . $post->{'VAL'}[$_] . "]" } @$class));
+ }
+ }
+}
+
+sub dumpClasses
+{
+ my ($self, $classes, $fh) = @_;
+ my $post = $self->post();
+
+ foreach (0 .. $#$classes) {
+ my $c = $classes->[$_];
+ if ($#$c > -1) {
+ $fh->printf("\n", $_);
+ foreach (@$c) {
+ $fh->printf("\n", $_, $post->{'VAL'}[$_]);
+ }
+ $fh->printf("\n");
+ }
+ }
+}
+
+1;
+
+=head1 BUGS
+
+None known
+
+=head1 AUTHOR
+
+Jonathan Kew L. See L for copyright and
+licensing.
+
+=cut
+