line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#! perl |
2
|
|
|
|
|
|
|
|
3
|
6
|
|
|
6
|
|
54554
|
use strict; |
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
146
|
|
4
|
6
|
|
|
6
|
|
27
|
use warnings; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
122
|
|
5
|
6
|
|
|
6
|
|
594
|
use utf8; |
|
6
|
|
|
|
|
22
|
|
|
6
|
|
|
|
|
45
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
package Text::Layout::FontConfig; |
8
|
|
|
|
|
|
|
|
9
|
6
|
|
|
6
|
|
202
|
use Carp; |
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
381
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $VERSION = "0.029"; |
14
|
|
|
|
|
|
|
|
15
|
6
|
|
|
6
|
|
2202
|
use Text::Layout::FontDescriptor; |
|
6
|
|
|
|
|
14
|
|
|
6
|
|
|
|
|
10957
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 NAME |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Text::Layout::FontConfig - Pango style font description for Text::Layout |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 SYNOPSIS |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
Font descriptors are strings that identify the characteristics of the |
24
|
|
|
|
|
|
|
desired font. For example, C. |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
The PDF context deals with physical fonts, e.g. built-in fonts like |
27
|
|
|
|
|
|
|
C and fonts loaded from font files like |
28
|
|
|
|
|
|
|
C. |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
To map font descriptions to physical fonts, these fonts must be |
31
|
|
|
|
|
|
|
registered. This defines a font family, style, and weight for the |
32
|
|
|
|
|
|
|
font. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
Note that Text::Layout::FontConfig is a singleton. Creating objects |
35
|
|
|
|
|
|
|
with new() will always return the same object. |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=cut |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
my %fonts; |
40
|
|
|
|
|
|
|
my @dirs; |
41
|
|
|
|
|
|
|
my $loader; |
42
|
|
|
|
|
|
|
my $debug = 0; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $weights = |
45
|
|
|
|
|
|
|
[ 100 => 'thin', |
46
|
|
|
|
|
|
|
100 => 'hairline', |
47
|
|
|
|
|
|
|
200 => 'extra light', |
48
|
|
|
|
|
|
|
200 => 'ultra light', |
49
|
|
|
|
|
|
|
300 => 'light', # supported |
50
|
|
|
|
|
|
|
350 => 'book', # supported |
51
|
|
|
|
|
|
|
400 => 'normal', # supported |
52
|
|
|
|
|
|
|
400 => 'regular', # supported |
53
|
|
|
|
|
|
|
500 => 'medium', # supported |
54
|
|
|
|
|
|
|
600 => 'semi bold', # supported 'semi' |
55
|
|
|
|
|
|
|
600 => 'demi bold', |
56
|
|
|
|
|
|
|
700 => 'bold', # supported |
57
|
|
|
|
|
|
|
800 => 'extra bold', |
58
|
|
|
|
|
|
|
800 => 'ultra bold', |
59
|
|
|
|
|
|
|
900 => 'black', |
60
|
|
|
|
|
|
|
900 => 'heavy', # supported |
61
|
|
|
|
|
|
|
950 => 'extra black', |
62
|
|
|
|
|
|
|
950 => 'ultra black', |
63
|
|
|
|
|
|
|
]; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head2 METHODS |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=over |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=item new( [ atts... ] ) |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
For convenience only. Text::Layout::FontConfig is a singleton. |
72
|
|
|
|
|
|
|
Creating objects with new() will always return the same object. |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Attributes: |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=over |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=item corefonts |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
If true, a predefined set of font names (the PDF corefonts) is registered. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=back |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=back |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=cut |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub new { |
89
|
4
|
|
|
4
|
1
|
1251
|
my ( $pkg, %atts ) = @_; |
90
|
4
|
|
|
|
|
15
|
my $self = bless \my $i => $pkg; |
91
|
4
|
100
|
|
|
|
21
|
if ( $atts{corefonts} ) { |
92
|
2
|
|
|
|
|
10
|
$self->register_corefonts; |
93
|
|
|
|
|
|
|
} |
94
|
4
|
50
|
|
|
|
17
|
if ( $atts{loader} ) { |
95
|
0
|
|
|
|
|
0
|
$loader = $atts{loader}; |
96
|
|
|
|
|
|
|
} |
97
|
4
|
|
|
|
|
26
|
return $self; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub reset { |
101
|
2
|
|
|
2
|
0
|
5
|
my ( $self ) = @_; |
102
|
2
|
|
|
|
|
4
|
%fonts = (); |
103
|
2
|
|
|
|
|
8
|
@dirs = (); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=over |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=item register_fonts( $font, $family, $style [ , $weight ] [ , $props ] ) |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Registers a font fmaily, style and weight for the given font. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
$font can be the name of a built-in font, or the name of a TrueType or |
113
|
|
|
|
|
|
|
OpenType font file. |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
$family is a font family name such as C, C, C, or |
116
|
|
|
|
|
|
|
C. It is possible to specify multiple family names, e.g., |
117
|
|
|
|
|
|
|
C. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
$style is the slant style, one of C, C, or C. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
$weight is the font weight, like C, or C. |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
For convenience, style combinations like "bolditalic" are allowed. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
A final hash reference can be passed to specify additional properties |
126
|
|
|
|
|
|
|
for this font. Recognized properties are: |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=over |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=item * |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
C - If set to a true value, this font will require text |
133
|
|
|
|
|
|
|
shaping. This is required for fonts that deal with complex glyph |
134
|
|
|
|
|
|
|
rendering and ligature handling like Devanagari. |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Text shaping requires module L. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=item * |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
C - If set to a true value, an alternative way to determine |
141
|
|
|
|
|
|
|
glyph height is used. This may improve results for some fonts. |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=item * |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
C, C - Overrides the font |
146
|
|
|
|
|
|
|
specified or calculated values for underline thickness and/or position. |
147
|
|
|
|
|
|
|
This may improve results for some fonts. |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=item * |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
C, C - Overrides the font |
152
|
|
|
|
|
|
|
specified or calculated values for strikeline thickness and/or position. |
153
|
|
|
|
|
|
|
This may improve results for some fonts. |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
Note that strikeline thickness will default to underline thickness, if set. |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=item * |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
C, C - Overrides the font |
160
|
|
|
|
|
|
|
specified or calculated values for overline thickness and/or position. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
This may improve results for some fonts. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
Note that overline thickness will default to underline thickness, if |
165
|
|
|
|
|
|
|
set. |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=back |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=back |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=cut |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub register_font { |
174
|
54
|
100
|
|
54
|
0
|
469
|
shift if UNIVERSAL::isa( $_[0], __PACKAGE__ ); |
175
|
54
|
|
|
|
|
61
|
my $props; |
176
|
54
|
50
|
|
|
|
144
|
$props = pop(@_) if UNIVERSAL::isa( $_[-1], 'HASH' ); |
177
|
54
|
|
|
|
|
95
|
my ( $font, $family, $style, $weight ) = @_; |
178
|
|
|
|
|
|
|
|
179
|
54
|
100
|
66
|
|
|
244
|
if ( $style && !$weight && $style =~ s/^(heavy|bold|semi(?:bold)?|medium|book|light)//i ) { |
|
|
|
100
|
|
|
|
|
180
|
24
|
|
|
|
|
49
|
$weight = $1; |
181
|
|
|
|
|
|
|
} |
182
|
54
|
|
100
|
|
|
142
|
$style = _norm_style( $style // "normal" ); |
183
|
54
|
|
100
|
|
|
141
|
$weight = _norm_weight( $weight // "normal" ); |
184
|
54
|
|
|
|
|
75
|
my $ff; |
185
|
54
|
50
|
|
|
|
93
|
if ( $font =~ /\.[ot]tf$/ ) { |
186
|
0
|
0
|
|
|
|
0
|
if ( $font =~ m;^/; ) { |
187
|
0
|
0
|
|
|
|
0
|
$ff = $font if -r -s $font; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
else { |
190
|
0
|
|
|
|
|
0
|
foreach ( @dirs ) { |
191
|
0
|
0
|
|
|
|
0
|
next unless -r -s "$_/$font"; |
192
|
0
|
|
|
|
|
0
|
$ff = "$_/$font"; |
193
|
0
|
|
|
|
|
0
|
last; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
else { |
198
|
|
|
|
|
|
|
# Assume corefont. |
199
|
54
|
|
|
|
|
59
|
$ff = $font |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
54
|
50
|
|
|
|
82
|
croak("Cannot find font: ", $font, "\n") unless $ff; |
203
|
|
|
|
|
|
|
|
204
|
54
|
|
|
|
|
124
|
foreach ( split(/\s*,\s*/, $family) ) { |
205
|
54
|
|
|
|
|
175
|
$fonts{lc $_}->{$style}->{$weight}->{loader} = $loader; |
206
|
54
|
|
|
|
|
99
|
$fonts{lc $_}->{$style}->{$weight}->{loader_data} = $ff; |
207
|
54
|
50
|
|
|
|
119
|
next unless $props; |
208
|
0
|
|
|
|
|
0
|
while ( my($k,$v) = each %$props ) { |
209
|
0
|
|
|
|
|
0
|
$fonts{lc $_}->{$style}->{$weight}->{$k} = $v; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=over |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=item add_fontdirs( @dirs ) |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
Adds one or more file paths to be searched for font files. |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=back |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=cut |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub add_fontdirs { |
226
|
0
|
0
|
|
0
|
1
|
0
|
shift if UNIVERSAL::isa( $_[0], __PACKAGE__ ); |
227
|
0
|
|
|
|
|
0
|
my ( @d ) = @_; |
228
|
|
|
|
|
|
|
|
229
|
0
|
|
|
|
|
0
|
foreach ( @d ) { |
230
|
0
|
0
|
|
|
|
0
|
unless ( -d -r -x ) { |
231
|
0
|
|
|
|
|
0
|
carp("Skipped font dir: $_ [$!]"); |
232
|
0
|
|
|
|
|
0
|
next; |
233
|
|
|
|
|
|
|
} |
234
|
0
|
|
|
|
|
0
|
push( @dirs, $_ ); |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=over |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=item register_aliases( $family, $aliases, ... ) |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
Adds aliases for existing font families. |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
Multiple aliases can be specified, e.g. |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
$layout->register_aliases( "times", "serif, default" ); |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
or |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
$layout->register_aliases( "times", "serif", "default" ); |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=back |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=cut |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub register_aliases { |
257
|
8
|
50
|
|
8
|
1
|
28
|
shift if UNIVERSAL::isa( $_[0], __PACKAGE__ ); |
258
|
8
|
|
|
|
|
19
|
my ( $family, @aliases ) = @_; |
259
|
|
|
|
|
|
|
carp("Unknown font family: $family") |
260
|
8
|
50
|
|
|
|
19
|
unless exists $fonts{lc $family}; |
261
|
8
|
|
|
|
|
14
|
foreach ( @aliases ) { |
262
|
18
|
|
|
|
|
34
|
foreach ( split( /\s*,\s*/, $_ ) ) { |
263
|
18
|
|
|
|
|
43
|
$fonts{lc $_} = $fonts{lc $family}; |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=over |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
=item register_corefonts( $noaliases ) |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
This is a convenience method that registers all built-in corefonts. |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
Aliases for families C, C, and C are added |
275
|
|
|
|
|
|
|
unless $noaliases is specified. |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
You do not need to call this method if you provide your own font |
278
|
|
|
|
|
|
|
registrations. |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=back |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
=cut |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
sub register_corefonts { |
285
|
2
|
50
|
|
2
|
1
|
18
|
shift if UNIVERSAL::isa( $_[0], __PACKAGE__ ); |
286
|
2
|
|
|
|
|
7
|
my ( $noaliases ) = @_; |
287
|
|
|
|
|
|
|
|
288
|
2
|
|
|
|
|
6
|
register_font( "Times-Roman", "Times" ); |
289
|
2
|
|
|
|
|
8
|
register_font( "Times-Bold", "Times", "Bold" ); |
290
|
2
|
|
|
|
|
6
|
register_font( "Times-Italic", "Times", "Italic" ); |
291
|
2
|
|
|
|
|
6
|
register_font( "Times-BoldItalic", "Times", "BoldItalic" ); |
292
|
|
|
|
|
|
|
|
293
|
2
|
50
|
|
|
|
21
|
register_aliases( "Times", "Serif" ) |
294
|
|
|
|
|
|
|
unless $noaliases; |
295
|
|
|
|
|
|
|
|
296
|
2
|
|
|
|
|
6
|
register_font( "Helvetica", "Helvetica" ); |
297
|
2
|
|
|
|
|
6
|
register_font( "Helvetica-Bold", "Helvetica", "Bold" ); |
298
|
2
|
|
|
|
|
6
|
register_font( "Helvetica-Oblique", "Helvetica", "Oblique" ); |
299
|
2
|
|
|
|
|
7
|
register_font( "Helvetica-BoldOblique", "Helvetica", "BoldOblique" ); |
300
|
|
|
|
|
|
|
|
301
|
2
|
50
|
|
|
|
19
|
register_aliases( "Helvetica", "Sans", "Arial" ) |
302
|
|
|
|
|
|
|
unless $noaliases; |
303
|
|
|
|
|
|
|
|
304
|
2
|
|
|
|
|
5
|
register_font( "Courier", "Courier" ); |
305
|
2
|
|
|
|
|
6
|
register_font( "Courier-Bold", "Courier", "Bold" ); |
306
|
2
|
|
|
|
|
7
|
register_font( "Courier-Oblique", "Courier", "Italic" ); |
307
|
2
|
|
|
|
|
16
|
register_font( "Courier-BoldOblique", "Courier", "BoldItalic" ); |
308
|
|
|
|
|
|
|
|
309
|
2
|
50
|
|
|
|
10
|
register_aliases( "Courier", "Mono", "Monospace", "fixed" ) |
310
|
|
|
|
|
|
|
unless $noaliases; |
311
|
2
|
50
|
|
|
|
7
|
register_aliases( "Courier", "Mono", "Monospace", "fixed" ) |
312
|
|
|
|
|
|
|
unless $noaliases; |
313
|
|
|
|
|
|
|
|
314
|
2
|
|
|
|
|
5
|
register_font( "ZapfDingbats", "Dingbats" ); |
315
|
|
|
|
|
|
|
|
316
|
2
|
|
|
|
|
7
|
register_font( "Georgia", "Georgia" ); |
317
|
2
|
|
|
|
|
6
|
register_font( "Georgia,Bold", "Georgia", "Bold" ); |
318
|
2
|
|
|
|
|
13
|
register_font( "Georgia,Italic", "Georgia", "Italic" ); |
319
|
2
|
|
|
|
|
6
|
register_font( "Georgia,BoldItalic", "Georgia", "BoldItalic" ); |
320
|
|
|
|
|
|
|
|
321
|
2
|
|
|
|
|
5
|
register_font( "Verdana", "Verdana" ); |
322
|
2
|
|
|
|
|
6
|
register_font( "Verdana,Bold", "Verdana", "Bold" ); |
323
|
2
|
|
|
|
|
5
|
register_font( "Verdana,Italic", "Verdana", "Italic" ); |
324
|
2
|
|
|
|
|
15
|
register_font( "Verdana,BoldItalic", "Verdana", "BoldItalic" ); |
325
|
|
|
|
|
|
|
|
326
|
2
|
|
|
|
|
5
|
register_font( "WebDings", "WebDings" ); |
327
|
2
|
|
|
|
|
5
|
register_font( "WingDings", "WingDings" ); |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
=over |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
=item find_font( $family, $style, $weight ) |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
Returns a font descriptor based on the given family, style and weight. |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
On Linux, fallback using fontconfig. |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=back |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=cut |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
sub find_font { |
343
|
21
|
100
|
|
21
|
1
|
88
|
shift if UNIVERSAL::isa( $_[0], __PACKAGE__ ); |
344
|
21
|
|
|
|
|
27
|
my $atts; |
345
|
21
|
50
|
|
|
|
75
|
$atts = pop(@_) if UNIVERSAL::isa( $_[-1], 'HASH' ); |
346
|
21
|
|
|
|
|
48
|
my ( $family, $style, $weight ) = @_; |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
my $try = sub { |
349
|
21
|
50
|
33
|
21
|
|
164
|
if ( $fonts{$family} |
|
|
|
33
|
|
|
|
|
350
|
|
|
|
|
|
|
&& $fonts{$family}->{$style} |
351
|
|
|
|
|
|
|
&& $fonts{$family}->{$style}->{$weight} ) { |
352
|
|
|
|
|
|
|
|
353
|
21
|
|
|
|
|
45
|
my $ff = $fonts{$family}->{$style}->{$weight}; |
354
|
21
|
|
|
|
|
93
|
my %i = ( family => $family, |
355
|
|
|
|
|
|
|
style => $style, |
356
|
|
|
|
|
|
|
weight => $weight ); |
357
|
|
|
|
|
|
|
; |
358
|
21
|
50
|
|
|
|
87
|
if ( $ff->{font} ) { |
|
|
50
|
|
|
|
|
|
359
|
0
|
|
|
|
|
0
|
$i{font} = $ff->{font}; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
elsif ( $ff->{loader_data} ) { |
362
|
21
|
|
|
|
|
38
|
$i{loader_data} = $ff->{loader_data}; |
363
|
21
|
|
|
|
|
33
|
$i{loader} = $loader; |
364
|
21
|
|
|
|
|
39
|
$i{cache} = $ff; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
else { |
367
|
0
|
|
|
|
|
0
|
return; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
21
|
|
|
|
|
44
|
for ( qw( shaping interline nosubset direction language |
371
|
|
|
|
|
|
|
underline_thickness underline_position |
372
|
|
|
|
|
|
|
strikeline_thickness strikeline_position |
373
|
|
|
|
|
|
|
overline_thickness overline_position |
374
|
|
|
|
|
|
|
) ) { |
375
|
231
|
|
|
|
|
399
|
$i{$_} = $ff->{$_}; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
21
|
|
|
|
|
160
|
return Text::Layout::FontDescriptor->new(%i); |
379
|
|
|
|
|
|
|
} |
380
|
21
|
|
|
|
|
97
|
}; |
381
|
|
|
|
|
|
|
|
382
|
21
|
|
50
|
|
|
64
|
$style = _norm_style( $style // "normal" ); |
383
|
21
|
|
50
|
|
|
76
|
$weight = _norm_weight( $weight // "normal" ); |
384
|
21
|
|
|
|
|
76
|
my $res = $try->(); |
385
|
21
|
50
|
|
|
|
151
|
return $res if $res; |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
# TODO: Some form of font fallback. |
388
|
0
|
0
|
|
|
|
0
|
if ( _fallback( $family, $style, $weight ) ) { |
389
|
0
|
|
|
|
|
0
|
$res = $try->(); |
390
|
0
|
0
|
|
|
|
0
|
return $res if $res; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
# Nope. |
394
|
0
|
|
|
|
|
0
|
croak("Cannot find font: $family $style $weight\n"); |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
=over |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
=item from_string( $description ) |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
Returns a font descriptor using a Pango-style font description, e.g. |
402
|
|
|
|
|
|
|
C. |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
On Linux, fallback using fontconfig. |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=back |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
=cut |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
my $stylep = qr/^( (?:heavy|bold|semi(?:bold)?|medium|book|light)? (?:oblique|italic) )$/ix; |
411
|
|
|
|
|
|
|
my $weightp = qr/^( (?:heavy|bold|semi(?:bold)?|medium|book|light) (?:oblique|italic)? )$/ix; |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub from_string { |
414
|
5
|
50
|
|
5
|
1
|
81
|
shift if UNIVERSAL::isa( $_[0], __PACKAGE__ ); |
415
|
5
|
|
|
|
|
21
|
my ( $description ) = @_; |
416
|
|
|
|
|
|
|
|
417
|
5
|
|
|
|
|
16
|
my $i = parse($description); |
418
|
|
|
|
|
|
|
|
419
|
5
|
|
|
|
|
51
|
my $res = find_font( $i->{family}, $i->{style}, $i->{weight} ); |
420
|
5
|
50
|
33
|
|
|
16
|
$res->set_size($i->{size}) if $res && $i->{size}; |
421
|
5
|
|
|
|
|
31
|
$res; |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=over |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=item parse( $description ) |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
Parses a Pango-style font description and returns a hash ref with keys |
429
|
|
|
|
|
|
|
C, C |