File Coverage

blib/lib/Font/TTF/Post.pm
Criterion Covered Total %
statement 46 103 44.6
branch 14 48 29.1
condition 2 12 16.6
subroutine 6 8 75.0
pod 4 5 80.0
total 72 176 40.9


line stmt bran cond sub pod time code
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             cannot 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 1     1   3 use strict;
  1         1  
  1         29  
67 1     1   3 use vars qw(@ISA @base_set %base_set %fields $VERSION $no25 @field_info @base_set);
  1         1  
  1         64  
68             require Font::TTF::Table;
69 1     1   3 use Font::TTF::Utils;
  1         1  
  1         1015  
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 1     1 0 1 my ($k, $v, $c, $i);
109 1         3 for ($i = 0; $i < $#field_info; $i += 2)
110             {
111 9         16 ($k, $v, $c) = TTF_Init_Fields($field_info[$i], $c, $field_info[$i + 1]);
112 9 50 33     28 next unless defined $k && $k ne "";
113 9         21 $fields{$k} = $v;
114             }
115 1         1 $i = 0;
116 1         2 %base_set = map {$_ => $i++} @base_set;
  258         252  
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 2     2 1 22 my ($self) = @_;
129 2 50       9 $self->SUPER::read or return $self;
130              
131 2         3 my ($dat, $dat1, $i, $off, $c, $maxoff, $form, $angle, $numGlyphs);
132 2         4 my ($fh) = $self->{' INFILE'};
133              
134 2         3 $numGlyphs = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
135 2 100       6 init unless ($fields{'FormatType'});
136 2         14 $fh->read($dat, 32);
137 2         20 TTF_Read_Fields($self, $dat, \%fields);
138              
139 2 50       8 if (int($self->{'FormatType'} + .5) == 1)
    0          
    0          
140             {
141 2         6 for ($i = 0; $i < 258; $i++)
142             {
143 516         420 $self->{'VAL'}[$i] = $base_set[$i];
144 516 50       1033 $self->{'STRINGS'}{$base_set[$i]} = $i unless (defined $self->{'STRINGS'}{$base_set[$i]});
145             }
146             } elsif (int($self->{'FormatType'} * 2 + .1) == 5)
147             {
148 0         0 $fh->read($dat, 2);
149 0         0 $numGlyphs = unpack("n", $dat);
150 0         0 $fh->read($dat, $numGlyphs);
151 0         0 for ($i = 0; $i < $numGlyphs; $i++)
152             {
153 0         0 $off = unpack("c", substr($dat, $i, 1));
154 0         0 $self->{'VAL'}[$i] = $base_set[$i + $off];
155 0 0       0 $self->{'STRINGS'}{$base_set[$i + $off]} = $i unless (defined $self->{'STRINGS'}{$base_set[$i + $off]});
156             }
157             } elsif (int($self->{'FormatType'} + .5) == 2)
158             {
159 0         0 my (@strings);
160            
161 0         0 $fh->read($dat, ($numGlyphs + 1) << 1);
162 0         0 for ($i = 0; $i < $numGlyphs; $i++)
163             {
164 0         0 $off = unpack("n", substr($dat, ($i + 1) << 1, 2));
165 0 0 0     0 $maxoff = $off if (!defined $maxoff || $off > $maxoff);
166             }
167 0         0 for ($i = 0; $i < $maxoff - 257; $i++)
168             {
169 0         0 $fh->read($dat1, 1);
170 0         0 $off = unpack("C", $dat1);
171 0         0 $fh->read($dat1, $off);
172 0         0 $strings[$i] = $dat1;
173             }
174 0         0 for ($i = 0; $i < $numGlyphs; $i++)
175             {
176 0         0 $off = unpack("n", substr($dat, ($i + 1) << 1, 2));
177 0 0       0 if ($off > 257)
178             {
179 0         0 $self->{'VAL'}[$i] = $strings[$off - 258];
180 0         0 $self->{'STRINGS'}{$strings[$off - 258]} = $i;
181             }
182             else
183             {
184 0         0 $self->{'VAL'}[$i] = $base_set[$off];
185 0 0       0 $self->{'STRINGS'}{$base_set[$off]} = $i unless (defined $self->{'STRINGS'}{$base_set[$off]});
186             }
187             }
188             }
189 2         6 $self;
190             }
191              
192              
193             =head2 $t->out($fh)
194              
195             Writes out a new Postscript name table from memory or copies from disk
196              
197             =cut
198              
199             sub out
200             {
201 2     2 1 4 my ($self, $fh) = @_;
202 2         2 my ($i, $num);
203              
204 2 50       7 return $self->SUPER::out($fh) unless $self->{' read'};
205              
206 2         5 $num = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
207              
208 2 50       6 init unless ($fields{'FormatType'});
209              
210 2   33     3 for ($i = $#{$self->{'VAL'}}; !defined $self->{'VAL'}[$i] && $i > 0; $i--)
  2         11  
211 0         0 { pop(@{$self->{'VAL'}}); }
  0         0  
212 2 50       2 if ($#{$self->{'VAL'}} < 0)
  2         6  
213 0         0 { $self->{'FormatType'} = 3; }
214             else
215             {
216 2         4 $self->{'FormatType'} = 1;
217 2         6 for ($i = 0; $i < $num; $i++)
218             {
219 196 50       450 if (!defined $base_set{$self->{'VAL'}[$i]})
    50          
220             {
221 0         0 $self->{'FormatType'} = 2;
222 0         0 last;
223             }
224             elsif ($base_set{$self->{'VAL'}[$i]} != $i)
225 0 0       0 { $self->{'FormatType'} = ($no25 ? 2 : 2.5); }
226             }
227             }
228              
229 2         8 $fh->print(TTF_Out_Fields($self, \%fields, 32));
230              
231 2 50       15 return $self if (int($self->{'FormatType'} + .4) == 3);
232              
233 2 50       12 if (int($self->{'FormatType'} + .5) == 2)
    50          
234             {
235 0         0 my (@ind);
236 0         0 my ($count) = 0;
237            
238 0         0 $fh->print(pack("n", $num));
239 0         0 for ($i = 0; $i < $num; $i++)
240             {
241 0 0       0 if (defined $base_set{$self->{'VAL'}[$i]})
242 0         0 { $fh->print(pack("n", $base_set{$self->{'VAL'}[$i]})); }
243             else
244             {
245 0         0 $fh->print(pack("n", $count + 258));
246 0         0 $ind[$count++] = $i;
247             }
248             }
249 0         0 for ($i = 0; $i < $count; $i++)
250             {
251 0         0 $fh->print(pack("C", length($self->{'VAL'}[$ind[$i]])));
252 0         0 $fh->print($self->{'VAL'}[$ind[$i]]);
253             }
254             } elsif (int($self->{'FormatType'} * 2 + .5) == 5)
255             {
256 0         0 $fh->print(pack("n", $num));
257 0         0 for ($i = 0; $i < $num; $i++)
258             { $fh->print(pack("c", defined $base_set{$self->{'VAL'}[$i]} ?
259 0 0       0 $base_set{$self->{'VAL'}[$i]} - $i : -$i)); }
260             }
261            
262 2         4 $self;
263             }
264              
265              
266             =head2 $t->XML_element($context, $depth, $key, $val)
267              
268             Outputs the names as one block of XML
269              
270             =cut
271              
272             sub XML_element
273             {
274 0     0 1   my ($self) = shift;
275 0           my ($context, $depth, $key, $val) = @_;
276 0           my ($fh) = $context->{'fh'};
277 0           my ($i);
278              
279 0 0 0       return $self->SUPER::XML_element(@_) unless ($key eq 'STRINGS' || $key eq 'VAL');
280 0 0         return unless ($key eq 'VAL');
281              
282 0           $fh->print("$depth\n");
283 0           for ($i = 0; $i <= $#{$self->{'VAL'}}; $i++)
  0            
284 0           { $fh->print("$depth$context->{'indent'}\n"); }
285 0           $fh->print("$depth\n");
286 0           $self;
287             }
288              
289             =head2 $t->minsize()
290              
291             Returns the minimum size this table can be. If it is smaller than this, then the table
292             must be bad and should be deleted or whatever.
293              
294             =cut
295              
296             sub minsize
297             {
298 0     0 1   return 32;
299             }
300              
301             1;
302              
303             =head1 BUGS
304              
305             =over 4
306              
307             =item *
308              
309             No support for type 4 tables
310              
311             =back
312              
313             =head1 AUTHOR
314              
315             Martin Hosken L.
316              
317              
318             =head1 LICENSING
319              
320             Copyright (c) 1998-2016, SIL International (http://www.sil.org)
321              
322             This module is released under the terms of the Artistic License 2.0.
323             For details, see the full text of the license in the file LICENSE.
324              
325              
326              
327             =cut
328              
329