File Coverage

blib/lib/PostScript/File/Metrics/Loader.pm
Criterion Covered Total %
statement 17 59 28.8
branch 0 22 0.0
condition n/a
subroutine 6 8 75.0
pod 2 2 100.0
total 25 91 27.4


line stmt bran cond sub pod time code
1             #---------------------------------------------------------------------
2             package PostScript::File::Metrics::Loader;
3             #
4             # Copyright 2009 Christopher J. Madsen
5             #
6             # Author: Christopher J. Madsen
7             # Created: 29 Oct 2009
8             #
9             # This program is free software; you can redistribute it and/or modify
10             # it under the same terms as Perl itself.
11             #
12             # This program is distributed in the hope that it will be useful,
13             # but WITHOUT ANY WARRANTY; without even the implied warranty of
14             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the
15             # GNU General Public License or the Artistic License for more details.
16             #
17             # ABSTRACT: Load metrics for PostScript fonts using Font::AFM
18             #---------------------------------------------------------------------
19              
20 1     1   3852 use 5.008;
  1         3  
21             our $VERSION = '2.20'; ## no critic
22             # This file is part of PostScript-File 2.23 (October 10, 2015)
23              
24 1     1   5 use strict;
  1         3  
  1         21  
25 1     1   6 use warnings;
  1         2  
  1         27  
26 1     1   5 use Carp 'confess';
  1         2  
  1         45  
27             # RECOMMEND PREREQ: Font::AFM
28 1     1   4 use Font::AFM;
  1         2  
  1         30  
29 1     1   5 use PostScript::File 2.00 ();
  1         14  
  1         1055  
30              
31             our %attribute = qw(
32             FullName full_name
33             FamilyName family
34             Weight weight
35             IsFixedPitch fixed_pitch
36             ItalicAngle italic_angle
37             FontBBox font_bbox
38             UnderlinePosition underline_position
39             UnderlineThickness underline_thickness
40             Version version
41             CapHeight cap_height
42             XHeight x_height
43             Ascender ascender
44             Descender descender
45             );
46              
47             our @numeric_attributes = qw(
48             ascender
49             cap_height
50             descender
51             italic_angle
52             underline_position
53             underline_thickness
54             x_height
55             );
56              
57             our @StandardEncoding = qw(
58             .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
59             .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
60             .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
61             .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
62             space exclam quotedbl numbersign
63             dollar percent ampersand quoteright
64             parenleft parenright asterisk plus
65             comma hyphen period slash
66             zero one two three
67             four five six seven
68             eight nine colon semicolon
69             less equal greater question
70             at A B C D E F G
71             H I J K L M N O
72             P Q R S T U V W
73             X Y Z bracketleft backslash bracketright asciicircum underscore
74             quoteleft a b c d e f g
75             h i j k l m n o
76             p q r s t u v w
77             x y z braceleft bar braceright asciitilde .notdef
78             .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
79             .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
80             .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
81             .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
82             .notdef exclamdown cent sterling
83             fraction yen florin section
84             currency quotesingle quotedblleft guillemotleft
85             guilsinglleft guilsinglright fi fl
86             .notdef endash dagger daggerdbl
87             periodcentered .notdef paragraph bullet
88             quotesinglbase quotedblbase quotedblright guillemotright
89             ellipsis perthousand .notdef questiondown
90             .notdef grave acute circumflex tilde macron breve dotaccent
91             dieresis .notdef ring cedilla .notdef hungarumlaut ogonek caron
92             emdash .notdef .notdef .notdef .notdef .notdef .notdef .notdef
93             .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
94             .notdef AE .notdef ordfeminine .notdef .notdef .notdef .notdef
95             Lslash Oslash OE ordmasculine .notdef .notdef .notdef .notdef
96             .notdef ae .notdef .notdef .notdef dotlessi .notdef .notdef
97             lslash oslash oe germandbls .notdef .notdef .notdef .notdef
98             );
99              
100             our @SymbolEncoding = (
101             ('.notdef') x 32,
102             # \040
103             qw(space exclam universal numbersign
104             existential percent ampersand suchthat
105             parenleft parenright asteriskmath plus
106             comma minus period slash
107             zero one two three
108             four five six seven
109             eight nine colon semicolon
110             less equal greater question),
111             # \100
112             qw(congruent Alpha Beta Chi
113             Delta Epsilon Phi Gamma
114             Eta Iota theta1 Kappa
115             Lambda Mu Nu Omicron
116             Pi Theta Rho Sigma
117             Tau Upsilon sigma1 Omega
118             Xi Psi Zeta bracketleft
119             therefore bracketright perpendicular underscore),
120             # \140
121             qw(radicalex alpha beta chi
122             delta epsilon phi gamma
123             eta iota phi1 kappa
124             lambda mu nu omicron
125             pi theta rho sigma
126             tau upsilon omega1 omega
127             xi psi zeta braceleft
128             bar braceright similar .notdef),
129             # \200
130             ('.notdef') x 32,
131             # \240
132             qw(Euro Upsilon1 minute lessequal
133             fraction infinity florin club
134             diamond heart spade arrowboth
135             arrowleft arrowup arrowright arrowdown
136             degree plusminus second greaterequal
137             multiply proportional partialdiff bullet
138             divide notequal equivalence approxequal
139             ellipsis arrowvertex arrowhorizex carriagereturn),
140             # \300
141             qw(aleph Ifraktur Rfraktur weierstrass
142             circlemultiply circleplus emptyset intersection
143             union propersuperset reflexsuperset notsubset
144             propersubset reflexsubset element notelement
145             angle gradient registerserif copyrightserif
146             trademarkserif product radical dotmath
147             logicalnot logicaland logicalor arrowdblboth
148             arrowdblleft arrowdblup arrowdblright arrowdbldown),
149             # \340
150             qw(lozenge angleleft registersans copyrightsans
151             trademarksans summation parenlefttp parenleftex
152             parenleftbt bracketlefttp bracketleftex bracketleftbt
153             bracelefttp braceleftmid braceleftbt braceex
154             .notdef angleright integral integraltp
155             integralex integralbt parenrighttp parenrightex
156             parenrightbt bracketrighttp bracketrightex bracketrightbt
157             bracerighttp bracerightmid bracerightbt .notdef),
158             );
159             #=====================================================================
160              
161              
162             sub load
163             {
164 0     0 1   my ($font, $encodings) = @_;
165              
166 0           my $afm = Font::AFM->new($font);
167              
168              
169             # Process the encoding-independent font attributes:
170 0 0         unless ($PostScript::File::Metrics::Info{$font}) {
171 0           my %info;
172 0           while (my ($method, $key) = each %attribute) {
173             # Font::AFM croaks instead of returning undef:
174 0           $info{$key} = do { local $@; eval { $afm->$method } };
  0            
  0            
  0            
175             }
176              
177             # Ensure Data::Dumper will dump numbers as such:
178 0           for (@numeric_attributes) {
179 0 0         $info{$_} += 0 if defined $info{$_};
180             }
181              
182             # Convert attributes to be more "Perlish":
183 0 0         $info{fixed_pitch} = ($info{fixed_pitch} eq 'true' ? 1 : 0);
184 0           $info{font_bbox} = [ map { $_ + 0 } split ' ', $info{font_bbox} ];
  0            
185              
186 0           $PostScript::File::Metrics::Info{$font} = \%info;
187             } # end unless info has been loaded
188              
189             # Create a width table for each requested encoding:
190 0           my $wxHash = $afm->Wx;
191              
192 0           foreach my $encoding (@$encodings) {
193 0 0         next if $PostScript::File::Metrics::Metrics{$font}{$encoding};
194              
195 0           my $vector = get_encoding_vector($encoding);
196              
197 0           my @wx;
198 0           for (0..255) {
199 0           my $name = $vector->[$_];
200 0 0         if (exists $wxHash->{$name}) {
201 0           push @wx, $wxHash->{$name} + 0;
202             } else {
203 0           push @wx, $wxHash->{'.notdef'} + 0;
204             }
205             } # end for 0..255
206              
207 0           $PostScript::File::Metrics::Metrics{$font}{$encoding} = \@wx;
208             } # end foreach $encoding
209             } # end load
210             #---------------------------------------------------------------------
211              
212              
213             sub get_encoding_vector
214             {
215 0     0 1   my ($encoding) = @_;
216              
217 0 0         return \@StandardEncoding if $encoding eq 'std';
218 0 0         return \@SymbolEncoding if $encoding eq 'sym';
219              
220 0 0         my $name = $PostScript::File::encoding_name{$encoding}
221             or confess "Unknown encoding $encoding";
222              
223              
224 0 0         $PostScript::File::encoding_def{$name}
225             =~ /\bSTARTDIFFENC\b(.+)\bENDDIFFENC\b/s
226             or confess "Can't find definition for $encoding";
227              
228 0           my $def = $1;
229 0           $def =~ s/%.*//g; # Strip comments
230              
231 0           my @vec = @StandardEncoding;
232              
233 0           my $i = 0;
234 0           while ($def =~ /(\S+)/g) {
235 0           my $term = $1;
236 0 0         if ($term =~ m!^/(.+)!) {
    0          
237 0           $vec[$i++] = $1;
238             } elsif ($term =~ /^\d+$/) {
239 0           $i = $term;
240             } else {
241 0           confess "Invalid term $term in $name";
242             }
243             }
244              
245 0           return \@vec;
246             } # end get_encoding_vector
247              
248             #=====================================================================
249             # Package Return Value:
250              
251             1;
252              
253             __END__