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

   1 package Font::TTF::Bsln;
   2
   3 =head1 NAME
   4
   5 Font::TTF::Bsln - Baseline table in a font
   6
   7 =head1 DESCRIPTION
   8
   9 =head1 INSTANCE VARIABLES
  10
  11 =item version
  12
  13 =item xformat
  14
  15 =item defaultBaseline
  16
  17 =item deltas
  18
  19 =item stdGlyph
  20
  21 =item ctlPoints
  22
  23 =item lookupFormat
  24
  25 =item lookup
  26
  27 =head1 METHODS
  28
  29 =cut
  30
  31 use strict;
  32 use vars qw(@ISA);
  33
  34 use Font::TTF::AATutils;
  35 use Font::TTF::Utils;
  36 require Font::TTF::Table;
  37
  38 @ISA = qw(Font::TTF::Table);
  39
  40 =head2 $t->read
  41
  42 Reads the table into memory
  43
  44 =cut
  45
  46 sub read
  47 {
  48     my ($self) = @_;
  49     my ($dat, $fh);
  50
  51     $self->SUPER::read or return $self;
  52
  53     $fh = $self->{' INFILE'};
  54     $fh->read($dat, 8);
  55     my ($version, $format, $defaultBaseline) = TTF_Unpack("vSS", $dat);
  56
  57     if ($format == 0 or $format == 1) {
  58         $fh->read($dat, 64);
  59         $self->{'deltas'} = [TTF_Unpack("s*", $dat)];
  60     }
  61     elsif ($format == 2 or $format == 3) {
  62         $fh->read($dat, 2);
  63         $self->{'stdGlyph'} = unpack("n", $dat);
  64         $fh->read($dat, 64);
  65         $self->{'ctlPoints'} = unpack("n*", $dat);
  66     }
  67     else {
  68         die "unknown table format";
  69     }
  70
  71     if ($format == 1 or $format == 3) {
  72         my $len = $self->{' LENGTH'} - ($fh->tell() - $self->{' OFFSET'});
  73         my ($lookupFormat, $lookup) = AAT_read_lookup($fh, 2, $len, $defaultBaseline);
  74         $self->{'lookupFormat'} = $lookupFormat;
  75         $self->{'lookup'} = $lookup;
  76     }
  77
  78     $self->{'version'} = $version;
  79     $self->{'format'} = $format;
  80     $self->{'defaultBaseline'} = $defaultBaseline;
  81
  82     $self;
  83 }
  84
  85 =head2 $t->out($fh)
  86
  87 Writes the table to a file either from memory or by copying
  88
  89 =cut
  90
  91 sub out
  92 {
  93     my ($self, $fh) = @_;
  94
  95     return $self->SUPER::out($fh) unless $self->{' read'};
  96
  97     my $format = $self->{'format'};
  98     my $defaultBaseline = $self->{'defaultBaseline'};
  99     $fh->print(TTF_Pack("vSS", $self->{'version'}, $format, $defaultBaseline));
 100
 101     AAT_write_lookup($fh, $self->{'lookupFormat'}, $self->{'lookup'}, 2, $defaultBaseline) if ($format == 1 or $format == 3);
 102 }
 103
 104 =head2 $t->print($fh)
 105
 106 Prints a human-readable representation of the table
 107
 108 =cut
 109
 110 sub print
 111 {
 112     my ($self, $fh) = @_;
 113
 114     $self->read;
 115
 116     $fh = 'STDOUT' unless defined $fh;
 117
 118     my $format = $self->{'format'};
 119     $fh->printf("version %f\nformat %d\ndefaultBaseline %d\n", $self->{'version'}, $format, $self->{'defaultBaseline'});
 120     if ($format == 0 or $format == 1) {
 121         $fh->printf("\tdeltas:\n");
 122         my $deltas = $self->{'deltas'};
 123         foreach (0 .. 31) {
 124             $fh->printf("\t\t%d: %d%s\n", $_, $deltas->[$_], defined baselineName_($_) ? "\t# " . baselineName_($_) : "");
 125         }
 126     }
 127     if ($format == 2 or $format == 3) {
 128         $fh->printf("\tstdGlyph = %d\n", $self->{'stdGlyph'});
 129         my $ctlPoints = $self->{'ctlPoints'};
 130         foreach (0 .. 31) {
 131             $fh->printf("\t\t%d: %d%s\n", $_, $ctlPoints->[$_], defined baselineName_($_) ? "\t# " . baselineName_($_) : "");
 132         }
 133     }
 134     if ($format == 1 or $format == 3) {
 135         $fh->printf("lookupFormat %d\n", $self->{'lookupFormat'});
 136         my $lookup = $self->{'lookup'};
 137         foreach (sort { $a <=> $b } keys %$lookup) {
 138             $fh->printf("\tglyph %d: %d%s\n", $_, $lookup->{$_}, defined baselineName_($_) ? "\t# " . baselineName_($_) : "");
 139         }
 140     }
 141 }
 142
 143 sub baselineName_
 144 {
 145     my ($b) = @_;
 146     my @baselines = ( 'Roman', 'Ideographic centered', 'Ideographic low', 'Hanging', 'Math' );
 147     $baselines[$b];
 148 }
 149
 150 1;
 151
 152
 153 =head1 BUGS
 154
 155 None known
 156
 157 =head1 AUTHOR
 158
 159 Jonathan Kew L<Jonathan_Kew@sil.org>. See L<Font::TTF::Font> for copyright and
 160 licensing.
 161
 162 =cut
 163