1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
# Information obtained from looking at the BDF file.
use strict;
use warnings;
use File::Spec::Functions;
use Font::FreeType;
my $ft;
my $skip_all;
BEGIN {
$ft = Font::FreeType->new;
$skip_all = $ft->version lt '2.1.1';
}
use Test::More ($skip_all ?
(skip_all => 'BDF not supported until FreeType 2.1.1') :
(tests => 76 + 4 * 2 + 1836 * 1));
exit 0 if $skip_all;
my $data_dir = catdir(qw( t data ));
# Load the BDF file.
my $bdf = $ft->face(catfile($data_dir, '5x7.bdf'));
ok($bdf, 'FreeType->face() should return an object');
is(ref $bdf, 'Font::FreeType::Face',
'FreeType->face() should return blessed ref');
# Test general properties of the face.
is($bdf->number_of_faces, 1, '$face->number_of_faces() is right');
is($bdf->current_face_index, 0, '$face->current_face_index() is right');
is($bdf->postscript_name, undef, 'there is no postscript name');
is($bdf->family_name, 'Fixed', '$face->family_name() is right');
is($bdf->style_name, 'Regular', 'no style name, defaults to "Regular"');
# Test face flags.
my %expected_flags = (
# Note: glyph names are currently unsupported in FreeType for BDF fonts,
# which is why it says there are none, when in fact there are.
has_glyph_names => 0,
has_horizontal_metrics => 1,
has_kerning => 0,
has_reliable_glyph_names => 0,
has_vertical_metrics => 0,
is_bold => 0,
is_fixed_width => 1,
is_italic => 0,
is_scalable => 0,
is_sfnt => 0,
);
foreach my $method (sort keys %expected_flags) {
my $expected = $expected_flags{$method};
my $got = $bdf->$method();
if ($expected) {
ok($bdf->$method(), "\$face->$method() method should return true");
}
else {
ok(!$bdf->$method(), "\$face->$method() method should return false");
}
}
# Some other general properties.
is($bdf->number_of_glyphs, 1837, '$face->number_of_glyphs() is right');
is($bdf->units_per_em, undef, 'units_per_em() meaningless');
is($bdf->underline_position, undef, 'underline position meaningless');
is($bdf->underline_thickness, undef, 'underline thickness meaningless');
is($bdf->ascender, undef, 'ascender meaningless');
is($bdf->descender, undef, 'descender meaningless');
# Test getting the set of fixed sizes available.
is(scalar $bdf->fixed_sizes, 1, 'BDF files have a single fixed size');
my ($fixed_size) = $bdf->fixed_sizes;
is($fixed_size->{width}, 5, 'fixed size width');
is($fixed_size->{height}, 7, 'fixed size width');
ok(abs($fixed_size->{size} - (70 / 722.7 * 72)) < 0.1,
"fixed size is 70 printer's decipoints");
ok(abs($fixed_size->{x_res_dpi} - 72) < 1, 'fixed size x resolution 72dpi');
ok(abs($fixed_size->{y_res_dpi} - 72) < 1, 'fixed size y resolution 72dpi');
ok(abs($fixed_size->{size} * $fixed_size->{x_res_dpi} / 72
- $fixed_size->{x_res_ppem}) < 0.1, 'fixed size x resolution in ppem');
ok(abs($fixed_size->{size} * $fixed_size->{y_res_dpi} / 72
- $fixed_size->{y_res_ppem}) < 0.1, 'fixed size y resolution in ppem');
is $bdf->namedinfos, undef, "no named infos for fixed size font";
is $bdf->bounding_box, undef, "no bounding box for fixed size font";
# Test iterating over all the characters. 1836*1 tests.
my $glyph_list_filename = catfile($data_dir, 'bdf_glyphs.txt');
open my $glyph_list, '<', $glyph_list_filename
or die "error opening file for list of glyphs: $!";
$bdf->foreach_char(sub {
die "shouldn't be any arguments passed in" unless @_ == 0;
my $line = <$glyph_list>;
die "not enough characters in listing file '$glyph_list_filename'"
unless defined $line;
chomp $line;
my ($unicode, $name) = split ' ', $line;
$unicode = hex $unicode;
is($_->char_code, $unicode,
"glyph $unicode char code in foreach_char()");
# Can't test the name yet because it isn't implemented in FreeType.
#is($_->name, $name, "glyph $unicode name in foreach_char()");
});
is(scalar <$glyph_list>, undef, "we aren't missing any glyphs");
subtest "charmaps" => sub {
subtest "default charmap" => sub {
my $default_cm = $bdf->charmap;
ok $default_cm;
is $default_cm->platform_id, 3;
is $default_cm->encoding_id, 1;
is $default_cm->encoding, FT_ENCODING_UNICODE;
};
subtest "available charmaps" => sub {
my $charmaps = $bdf->charmaps;
ok $charmaps;
is ref($charmaps), 'ARRAY';
is scalar(@$charmaps), 1;
}
};
# Test metrics on some particlar glyphs.
my %glyph_metrics = (
'A' => { name => 'A', advance => 5,
LBearing => 0, RBearing => 0 },
'_' => { name => 'underscore', advance => 5,
LBearing => 0, RBearing => 0 },
'`' => { name => 'grave', advance => 5,
LBearing => 0, RBearing => 0 },
'g' => { name => 'g', advance => 5,
LBearing => 0, RBearing => 0 },
'|' => { name => 'bar', advance => 5,
LBearing => 0, RBearing => 0 },
);
# 4*2 tests.
foreach my $get_by_code (0 .. 1) {
foreach my $char (sort keys %glyph_metrics) {
my $glyph = $get_by_code ? $bdf->glyph_from_char_code(ord $char)
: $bdf->glyph_from_char($char);
die "no glyph for character '$char'" unless $glyph;
local $_ = $glyph_metrics{$char};
# Can't do names until it's implemented in FreeType.
#is($glyph->name, $_->{name},
# "name of glyph '$char'");
is($glyph->horizontal_advance, $_->{advance},
"advance width of glyph '$char'");
is($glyph->left_bearing, $_->{LBearing},
"left bearing of glyph '$char'");
is($glyph->right_bearing, $_->{RBearing},
"right bearing of glyph '$char'");
is($glyph->width, $_->{advance} - $_->{LBearing} - $_->{RBearing},
"width of glyph '$char'");
}
}
# Test kerning.
my %kerning = (
__ => 0,
AA => 0,
AV => 0,
'T.' => 0,
);
foreach my $pair (sort keys %kerning) {
my ($kern_x, $kern_y) = $bdf->kerning(
map { $bdf->glyph_from_char($_)->index } split //, $pair);
is($kern_x, $kerning{$pair}, "horizontal kerning of '$pair'");
is($kern_y, 0, "vertical kerning of '$pair'");
}
# Get just the horizontal kerning more conveniently.
my $kern_x = $bdf->kerning(
map { $bdf->glyph_from_char($_)->index } 'A', 'V');
is($kern_x, 0, "horizontal kerning of 'AV' in scalar context");
# vim:ft=perl ts=4 sw=4 expandtab:
|
