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

   1 package Font::TTF::Prop;
   2
   3 =head1 NAME
   4
   5 Font::TTF::Prop - Glyph Properties table in a font
   6
   7 =head1 DESCRIPTION
   8
   9 =head1 INSTANCE VARIABLES
  10
  11 =item version
  12
  13 =item default
  14
  15 =item lookup
  16
  17 Hash of property values keyed by glyph number
  18
  19 =item lookupFormat
  20
  21 =head1 METHODS
  22
  23 =cut
  24
  25 use strict;
  26 use vars qw(@ISA);
  27 use Font::TTF::Utils;
  28 use Font::TTF::AATutils;
  29 use Font::TTF::Segarr;
  30
  31 @ISA = qw(Font::TTF::Table);
  32
  33 =head2 $t->read
  34
  35 Reads the table into memory
  36
  37 =cut
  38
  39 sub read
  40 {
  41     my ($self) = @_;
  42     my ($dat, $fh);
  43     my ($version, $lookupPresent, $default);
  44
  45     $self->SUPER::read or return $self;
  46
  47     $fh = $self->{' INFILE'};
  48     $fh->read($dat, 8);
  49     ($version, $lookupPresent, $default) = TTF_Unpack("vSS", $dat);
  50
  51     if ($lookupPresent) {
  52         my ($format, $lookup) = AAT_read_lookup($fh, 2, $self->{' LENGTH'} - 8, $default);
  53         $self->{'lookup'} = $lookup;
  54         $self->{'format'} = $format;
  55     }
  56
  57     $self->{'version'} = $version;
  58     $self->{'default'} = $default;
  59
  60     $self;
  61 }
  62
  63
  64 =head2 $t->out($fh)
  65
  66 Writes the table to a file either from memory or by copying
  67
  68 =cut
  69
  70 sub out
  71 {
  72     my ($self, $fh) = @_;
  73     my ($default, $lookup);
  74
  75     return $self->SUPER::out($fh) unless $self->{' read'};
  76
  77     $default = $self->{'default'};
  78     $lookup = $self->{'lookup'};
  79     $fh->print(TTF_Pack("vSS", $self->{'version'}, (defined $lookup ? 1 : 0), $default));
  80
  81     AAT_write_lookup($fh, $self->{'format'}, $lookup, 2, $default) if (defined $lookup);
  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 ($lookup);
  94
  95     $self->read;
  96
  97     $fh = 'STDOUT' unless defined $fh;
  98
  99     $fh->printf("version %f\ndefault %04x # %s\n", $self->{'version'}, $self->{'default'}, meaning_($self->{'default'}));
 100     $lookup = $self->{'lookup'};
 101     if (defined $lookup) {
 102         $fh->printf("format %d\n", $self->{'format'});
 103         foreach (sort { $a <=> $b } keys %$lookup) {
 104             $fh->printf("\t%d -> %04x # %s\n", $_, $lookup->{$_}, meaning_($lookup->{$_}));
 105         }
 106     }
 107 }
 108
 109 sub meaning_
 110 {
 111     my ($val) = @_;
 112     my ($res);
 113
 114     my @types = (
 115         "Strong left-to-right",
 116         "Strong right-to-left",
 117         "Arabic letter",
 118         "European number",
 119         "European number separator",
 120         "European number terminator",
 121         "Arabic number",
 122         "Common number separator",
 123         "Block separator",
 124         "Segment separator",
 125         "Whitespace",
 126         "Other neutral");
 127     $res = $types[$val & 0x001f] or ("Undefined [" . ($val & 0x001f) . "]");
 128
 129     $res .= ", floater" if $val & 0x8000;
 130     $res .= ", hang left" if $val & 0x4000;
 131     $res .= ", hang right" if $val & 0x2000;
 132     $res .= ", attaches on right" if $val & 0x0080;
 133     $res .= ", pair" if $val & 0x1000;
 134     my $pairOffset = ($val & 0x0f00) >> 8;
 135     $pairOffset = $pairOffset - 16 if $pairOffset > 7;
 136     $res .= $pairOffset > 0 ? " +" . $pairOffset : $pairOffset < 0 ? " " . $pairOffset : "";
 137
 138     $res;
 139 }
 140
 141 1;
 142
 143
 144 =head1 BUGS
 145
 146 None known
 147
 148 =head1 AUTHOR
 149
 150 Jonathan Kew L<Jonathan_Kew@sil.org>. See L<Font::TTF::Font> for copyright and
 151 licensing.
 152
 153 =cut
 154