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

   1 package Font::TTF::Fdsc;
   2
   3 =head1 NAME
   4
   5 Font::TTF::Fdsc - Font Descriptors table in a font
   6
   7 =head1 DESCRIPTION
   8
   9 =head1 INSTANCE VARIABLES
  10
  11 =item version
  12
  13 =item descriptors
  14
  15 Hash keyed by descriptor tags
  16
  17 =head1 METHODS
  18
  19 =cut
  20
  21 use strict;
  22 use vars qw(@ISA %fields);
  23 use Font::TTF::Utils;
  24
  25 @ISA = qw(Font::TTF::Table);
  26
  27 =head2 $t->read
  28
  29 Reads the table into memory
  30
  31 =cut
  32
  33 sub read
  34 {
  35     my ($self) = @_;
  36     my ($dat, $fh, $numDescs, $tag, $descs);
  37
  38     $self->SUPER::read or return $self;
  39
  40     $fh = $self->{' INFILE'};
  41     $fh->read($dat, 4);
  42     $self->{'version'} = TTF_Unpack("v", $dat);
  43
  44     $fh->read($dat, 4);
  45
  46     foreach (1 .. unpack("N", $dat)) {
  47         $fh->read($tag, 4);
  48         $fh->read($dat, 4);
  49         $descs->{$tag} = ($tag eq 'nalf') ? unpack("N", $dat) : TTF_Unpack("f", $dat);
  50     }
  51
  52     $self->{'descriptors'} = $descs;
  53
  54     $self;
  55 }
  56
  57
  58 =head2 $t->out($fh)
  59
  60 Writes the table to a file either from memory or by copying
  61
  62 =cut
  63
  64 sub out
  65 {
  66     my ($self, $fh) = @_;
  67     my ($descs);
  68
  69     return $self->SUPER::out($fh) unless $self->{' read'};
  70
  71     $fh->print(TTF_Pack("v", $self->{'version'}));
  72
  73     $descs = $self->{'descriptors'} or {};
  74
  75     $fh->print(pack("N", scalar keys %$descs));
  76     foreach (sort keys %$descs) {
  77         $fh->print($_);
  78         $fh->print(($_ eq 'nalf') ? pack("N", $descs->{$_}) : TTF_Pack("f", $descs->{$_}));
  79     }
  80
  81     $self;
  82 }
  83
  84 =head2 $t->print($fh)
  85
  86 Prints a human-readable representation of the table
  87
  88 =cut
  89
  90 sub print
  91 {
  92     my ($self, $fh) = @_;
  93     my ($descs, $k);
  94
  95     $self->read;
  96
  97     $fh = 'STDOUT' unless defined $fh;
  98
  99     $descs = $self->{'descriptors'};
 100     foreach $k (sort keys %$descs) {
 101         if ($k eq 'nalf') {
 102             $fh->printf("Descriptor '%s' = %d\n", $k, $descs->{$k});
 103         }
 104         else {
 105             $fh->printf("Descriptor '%s' = %f\n", $k, $descs->{$k});
 106         }
 107     }
 108
 109     $self;
 110 }
 111
 112 1;
 113
 114
 115 =head1 BUGS
 116
 117 None known
 118
 119 =head1 AUTHOR
 120
 121 Jonathan Kew L<Jonathan_Kew@sil.org>. See L<Font::TTF::Font> for copyright and
 122 licensing.
 123
 124 =cut
 125