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
|
#!/usr/bin/perl -w
# -*- perl -*-
# Test case from https://rt.cpan.org/Ticket/Display.html?id=42043
# Fails if XFT=1 is activated.
# Not in normal test suite, because result depends on fonts installed on system.
use strict;
use Getopt::Long;
use Tk;
use Tk::Config;
use Tk::Font;
BEGIN {
if (!eval q{
use Test::More;
1;
}) {
print "1..0 # skip no Test::More module\n";
exit;
}
}
my $Xft = $Tk::Config::xlib =~ /-lXft\b/;
if (!$Xft) {
plan skip_all => 'Hardcoded font values work only for XFT=1';
exit 0;
}
plan tests => 5;
my $do_display;
GetOptions("display" => \$do_display)
or die "usage: $0 [-display]";
my $mw = MainWindow->new;
{
# The empty array does not work at all for XFT=0
my $label = $mw->Label(-text=>"small font, no bold",-font=>[])->pack;
my %fa = $label->cget(-font)->actual;
is_deeply(\%fa, { -weight => 'normal',
-underline => 0,
-family => 'Bitstream Vera Sans',
-slant => 'roman',
-size => -14,
-overstrike => 0,
}, 'Unchanged font size, normal weight');
}
{
my $label = $mw->Label(-text=>"small font, bold",-font=>[-weight=>'bold'])->pack;
my %fa = $label->cget(-font)->actual;
is_deeply(\%fa, { -weight => 'bold',
-underline => 0,
-family => 'Bitstream Vera Sans',
-slant => 'roman',
-size => -14,
-overstrike => 0,
}, 'Unchanged font size, bold');
}
{
my $label = $mw->Label(-text=>"32-point, bold",-font=>[-size=>'32', -weight=>'bold'])->pack;
my %fa = $label->cget(-font)->actual;
is_deeply(\%fa, { -weight => 'bold',
-underline => 0,
-family => 'Bitstream Vera Sans',
-slant => 'roman',
-size => -38,
-overstrike => 0,
}, '32 point size, bold');
}
{
my $label = $mw->Label(-text=>"32-point, bold, string spec",-font=>'{sans serif} 32 bold')->pack;
my %fa = $label->cget(-font)->actual;
is_deeply(\%fa, { -weight => 'bold',
-underline => 0,
-family => 'Bitstream Vera Sans',
-slant => 'roman',
-size => -38,
-overstrike => 0,
}, '32 point size, bold');
}
{
my $label = $mw->Label(-text=>"32-point, no bold",-font=>[-size=>'32'])->pack;
my %fa = $label->cget(-font)->actual;
is_deeply(\%fa, { -weight => 'normal',
-underline => 0,
-family => 'Bitstream Vera Sans',
-slant => 'roman',
-size => -38,
-overstrike => 0,
}, '32 point size, normal weight');
}
if ($do_display) {
my $button = $mw->Button(-text => "Quit",
-command => sub { exit })
->pack();
MainLoop;
}
__END__
|
