# 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 argumetns 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: