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

   1 package Font::TTF::Post;
   2
   3 =head1 NAME
   4
   5 Font::TTF::Post - Holds the Postscript names for each glyph
   6
   7 =head1 DESCRIPTION
   8
   9 Holds the postscript names for glyphs. Note that they are not held as an
  10 array, but as indexes into two lists. The first list is the standard Postscript
  11 name list defined by the TrueType standard. The second comes from the font
  12 directly.
  13
  14 Looking up a glyph from a Postscript name or a name from a glyph number is
  15 achieved through methods rather than variable lookup.
  16
  17 This class handles PostScript table types of 1, 2, 2.5 & 3, but not version 4.
  18 Support for version 2.5 is as per Apple spec rather than MS.
  19
  20 The way to look up Postscript names or glyphs is:
  21
  22     $pname = $f->{'post'}{'VAL'}[$gnum];
  23     $gnum = $f->{'post'}{'STRINGS'}{$pname};
  24
  25 =head1 INSTANCE VARIABLES
  26
  27 Due to different systems having different limitations, there are various class
  28 variables available to control what post table types can be written.
  29
  30 =over 4
  31
  32 =item $Font::TTF::Post::no25
  33
  34 If set tells Font::TTF::Post::out to use table type 2 instead of 2.5 in case apps
  35 can't handle version 2.5.
  36
  37 =item VAL
  38
  39 Contains an array indexed by glyph number of Postscript names. This is used when
  40 writing out a font.
  41
  42 =item STRINGS
  43
  44 An associative array of Postscript names mapping to the highest glyph with that
  45 name. These may not be in sync with VAL.
  46
  47 =back
  48
  49 In addition there are the standard introductory variables defined in the
  50 standard:
  51
  52     FormatType
  53     italicAngle
  54     underlinePosition
  55     underlineThickness
  56     isFixedPitch
  57     minMemType42
  58     maxMemType42
  59     minMemType1
  60     maxMemType1
  61
  62 =head1 METHODS
  63
  64 =cut
  65
  66 use strict;
  67 use vars qw(@ISA @base_set %base_set %fields $VERSION $no25 @field_info @base_set);
  68 require Font::TTF::Table;
  69 use Font::TTF::Utils;
  70
  71 $no25 = 1;                  # officially deprecated format 2.5 tables in MS spec 1.3
  72
  73 @ISA = qw(Font::TTF::Table);
  74 @field_info = (
  75     'FormatType' => 'f',
  76     'italicAngle' => 'f',
  77     'underlinePosition' => 's',
  78     'underlineThickness' => 's',
  79     'isFixedPitch' => 'L',
  80     'minMemType42' => 'L',
  81     'maxMemType42' => 'L',
  82     'minMemType1' => 'L',
  83     'maxMemType1' => 'L');
  84 @base_set = qw(.notdef .null nonmarkingreturn space exclam quotedbl numbersign dollar percent ampersand quotesingle
  85     parenleft parenright asterisk plus comma hyphen period slash zero one two three four five six
  86     seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q
  87     R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore grave a b c d e f g h
  88     i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde Adieresis Aring Ccedilla
  89     Eacute Ntilde Odieresis Udieresis aacute agrave acircumflex adieresis atilde aring ccedilla eacute
  90     egrave ecircumflex edieresis iacute igrave icircumflex idieresis ntilde oacute ograve ocircumflex
  91     odieresis otilde uacute ugrave ucircumflex udieresis dagger degree cent sterling section bullet
  92     paragraph germandbls registered copyright trademark acute dieresis notequal AE Oslash infinity
  93     plusminus lessequal greaterequal yen mu partialdiff summation product pi integral ordfeminine
  94     ordmasculine Omega ae oslash questiondown exclamdown logicalnot radical florin approxequal
  95     Delta guillemotleft guillemotright ellipsis nonbreakingspace Agrave Atilde Otilde OE oe endash emdash
  96     quotedblleft quotedblright quoteleft quoteright divide lozenge ydieresis Ydieresis fraction currency
  97     guilsinglleft guilsinglright fi fl daggerdbl periodcentered quotesinglbase quotedblbase perthousand
  98     Acircumflex Ecircumflex Aacute Edieresis Egrave Iacute Icircumflex Idieresis Igrave Oacute Ocircumflex
  99     apple Ograve Uacute Ucircumflex Ugrave dotlessi circumflex tilde macron breve dotaccent
 100     ring cedilla hungarumlaut ogonek caron Lslash lslash Scaron scaron Zcaron zcaron brokenbar Eth eth
 101     Yacute yacute Thorn thorn minus multiply onesuperior twosuperior threesuperior onehalf onequarter
 102     threequarters franc Gbreve gbreve Idotaccent Scedilla scedilla Cacute cacute Ccaron ccaron dcroat);
 103
 104 $VERSION = 0.01;        # MJPH   5-AUG-1998     Re-organise data structures
 105
 106 sub init
 107 {
 108     my ($k, $v, $c, $i);
 109     for ($i = 0; $i < $#field_info; $i += 2)
 110     {
 111         ($k, $v, $c) = TTF_Init_Fields($field_info[$i], $c, $field_info[$i + 1]);
 112         next unless defined $k && $k ne "";
 113         $fields{$k} = $v;
 114     }
 115     $i = 0;
 116     %base_set = map {$_ => $i++} @base_set;
 117 }
 118
 119
 120 =head2 $t->read
 121
 122 Reads the Postscript table into memory from disk
 123
 124 =cut
 125
 126 sub read
 127 {
 128     my ($self) = @_;
 129     my ($dat, $dat1, $i, $off, $c, $maxoff, $form, $angle, $numGlyphs);
 130     my ($fh) = $self->{' INFILE'};
 131
 132     $numGlyphs = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
 133     $self->SUPER::read or return $self;
 134     init unless ($fields{'FormatType'});
 135     $fh->read($dat, 32);
 136     TTF_Read_Fields($self, $dat, \%fields);
 137
 138     if (int($self->{'FormatType'} + .5) == 1)
 139     {
 140         for ($i = 0; $i < 258; $i++)
 141         {
 142             $self->{'VAL'}[$i] = $base_set[$i];
 143             $self->{'STRINGS'}{$base_set[$i]} = $i unless (defined $self->{'STRINGS'}{$base_set[$i]});
 144         }
 145     } elsif (int($self->{'FormatType'} * 2 + .1) == 5)
 146     {
 147         $fh->read($dat, 2);
 148         $numGlyphs = unpack("n", $dat);
 149         $fh->read($dat, $numGlyphs);
 150         for ($i = 0; $i < $numGlyphs; $i++)
 151         {
 152             $off = unpack("c", substr($dat, $i, 1));
 153             $self->{'VAL'}[$i] = $base_set[$i + $off];
 154             $self->{'STRINGS'}{$base_set[$i + $off]} = $i unless (defined $self->{'STRINGS'}{$base_set[$i + $off]});
 155         }
 156     } elsif (int($self->{'FormatType'} + .5) == 2)
 157     {
 158         my (@strings);
 159
 160         $fh->read($dat, ($numGlyphs + 1) << 1);
 161         for ($i = 0; $i < $numGlyphs; $i++)
 162         {
 163             $off = unpack("n", substr($dat, ($i + 1) << 1, 2));
 164             $maxoff = $off if (!defined $maxoff || $off > $maxoff);
 165         }
 166         for ($i = 0; $i < $maxoff - 257; $i++)
 167         {
 168             $fh->read($dat1, 1);
 169             $off = unpack("C", $dat1);
 170             $fh->read($dat1, $off);
 171             $strings[$i] = $dat1;
 172         }
 173         for ($i = 0; $i < $numGlyphs; $i++)
 174         {
 175             $off = unpack("n", substr($dat, ($i + 1) << 1, 2));
 176             if ($off > 257)
 177             {
 178                 $self->{'VAL'}[$i] = $strings[$off - 258];
 179                 $self->{'STRINGS'}{$strings[$off - 258]} = $i;
 180             }
 181             else
 182             {
 183                 $self->{'VAL'}[$i] = $base_set[$off];
 184                 $self->{'STRINGS'}{$base_set[$off]} = $i unless (defined $self->{'STRINGS'}{$base_set[$off]});
 185             }
 186         }
 187     }
 188     $self;
 189 }
 190
 191
 192 =head2 $t->out($fh)
 193
 194 Writes out a new Postscript name table from memory or copies from disk
 195
 196 =cut
 197
 198 sub out
 199 {
 200     my ($self, $fh) = @_;
 201     my ($i, $num);
 202
 203     return $self->SUPER::out($fh) unless $self->{' read'};
 204
 205     $num = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
 206
 207     init unless ($fields{'FormatType'});
 208
 209     for ($i = $#{$self->{'VAL'}}; !defined $self->{'VAL'}[$i] && $i > 0; $i--)
 210     { pop(@{$self->{'VAL'}}); }
 211     if ($#{$self->{'VAL'}} < 0)
 212     { $self->{'FormatType'} = 3; }
 213     else
 214     {
 215         $self->{'FormatType'} = 1;
 216         for ($i = 0; $i < $num; $i++)
 217         {
 218             if (!defined $base_set{$self->{'VAL'}[$i]})
 219             {
 220                 $self->{'FormatType'} = 2;
 221                 last;
 222             }
 223             elsif ($base_set{$self->{'VAL'}[$i]} != $i)
 224             { $self->{'FormatType'} = ($no25 ? 2 : 2.5); }
 225         }
 226     }
 227
 228     $fh->print(TTF_Out_Fields($self, \%fields, 32));
 229
 230     return $self if (int($self->{'FormatType'} + .4) == 3);
 231
 232     if (int($self->{'FormatType'} + .5) == 2)
 233     {
 234         my (@ind);
 235         my ($count) = 0;
 236
 237         $fh->print(pack("n", $num));
 238         for ($i = 0; $i < $num; $i++)
 239         {
 240             if (defined $base_set{$self->{'VAL'}[$i]})
 241             { $fh->print(pack("n", $base_set{$self->{'VAL'}[$i]})); }
 242             else
 243             {
 244                 $fh->print(pack("n", $count + 258));
 245                 $ind[$count++] = $i;
 246             }
 247         }
 248         for ($i = 0; $i < $count; $i++)
 249         {
 250             $fh->print(pack("C", length($self->{'VAL'}[$ind[$i]])));
 251             $fh->print($self->{'VAL'}[$ind[$i]]);
 252         }
 253     } elsif (int($self->{'FormatType'} * 2 + .5) == 5)
 254     {
 255         $fh->print(pack("n", $num));
 256         for ($i = 0; $i < $num; $i++)
 257         { $fh->print(pack("c", defined $base_set{$self->{'VAL'}[$i]} ?
 258                     $base_set{$self->{'VAL'}[$i]} - $i : -$i)); }
 259     }
 260
 261     $self;
 262 }
 263
 264
 265 =head2 $t->XML_element($context, $depth, $key, $val)
 266
 267 Outputs the names as one block of XML
 268
 269 =cut
 270
 271 sub XML_element
 272 {
 273     my ($self) = shift;
 274     my ($context, $depth, $key, $val) = @_;
 275     my ($fh) = $context->{'fh'};
 276     my ($i);
 277
 278     return $self->SUPER::XML_element(@_) unless ($key eq 'STRINGS' || $key eq 'VAL');
 279     return unless ($key eq 'VAL');
 280
 281     $fh->print("$depth<names>\n");
 282     for ($i = 0; $i <= $#{$self->{'VAL'}}; $i++)
 283     { $fh->print("$depth$context->{'indent'}<name post='$self->{'VAL'}[$i]' gid='$i'/>\n"); }
 284     $fh->print("$depth</names>\n");
 285     $self;
 286 }
 287
 288 1;
 289
 290 =head1 BUGS
 291
 292 =over 4
 293
 294 =item *
 295
 296 No support for type 4 tables
 297
 298 =back
 299
 300 =head1 AUTHOR
 301
 302 Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
 303 licensing.
 304
 305 =cut
 306