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
|
#!/usr/bin/perl -w
use strict;
#use lib qw(blib/lib blib/arch);
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
use Test::More tests => 20;
BEGIN { use_ok('Imager') };
init_log("testout/t36oofont.log", 1);
my $fontname_tt=$ENV{'TTFONTTEST'}||'./fontfiles/dodge.ttf';
my $fontname_pfb=$ENV{'T1FONTTESTPFB'}||'./fontfiles/dcr10.pfb';
my $green=Imager::Color->new(92,205,92,128);
die $Imager::ERRSTR unless $green;
my $red=Imager::Color->new(205, 92, 92, 255);
die $Imager::ERRSTR unless $red;
SKIP:
{
i_has_format("t1") && -f $fontname_pfb
or skip("T1lib missing or disabled", 8);
my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
my $font=Imager::Font->new(file=>$fontname_pfb,size=>25)
or die $img->{ERRSTR};
ok(1, "created font");
ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
"draw text");
$img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green);
my $text="LLySja";
my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
is(@bbox, 8, "bounding box list length");
$img->box(box=>\@bbox, color=>$green);
# "utf8" support
$text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1,
overline=>1),
"draw 'utf8' hand-encoded text");
ok($img->string(font=>$font, text=>$text, 'x'=>140, 'y'=>50, utf8=>1,
underline=>1, channel=>2),
"channel 'utf8' hand-encoded text");
SKIP:
{
$] >= 5.006
or skip("perl too old for native utf8", 2);
eval q{$text = "A\x{2010}A"};
ok($img->string(font=>$font, text=>$text, 'x'=>180, 'y'=>50,
strikethrough=>1),
"draw native UTF8 text");
ok($img->string(font=>$font, text=>$text, 'x'=>220, 'y'=>50, channel=>1),
"channel native UTF8 text");
}
ok($img->write(file=>"testout/t36oofont1.ppm", type=>'pnm'),
"write t36oofont1.ppm")
or print "# ",$img->errstr,"\n";
}
SKIP:
{
i_has_format("tt") && -f $fontname_tt
or skip("FT1.x missing or disabled", 10);
my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
my $font=Imager::Font->new(file=>$fontname_tt,size=>25)
or die $img->{ERRSTR};
ok(1, "create TT font object");
ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
"draw text");
$img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green);
my $text="LLySja";
my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
is(@bbox, 8, "bbox list size");
$img->box(box=>\@bbox, color=>$green);
$text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1),
"draw hand-encoded UTF8 text");
SKIP:
{
$] >= 5.006
or skip("perl too old for native utf8", 1);
eval q{$text = "A\x{2010}A"};
ok($img->string(font=>$font, text=>$text, 'x'=>200, 'y'=>50),
"draw native UTF8 text");
}
ok($img->write(file=>"testout/t36oofont2.ppm", type=>'pnm'),
"write t36oofont2.ppm")
or print "# ", $img->errstr,"\n";
ok($font->utf8, "make sure utf8 method returns true");
my $has_chars = $font->has_chars(string=>"\x01A");
is($has_chars, "\x00\x01", "has_chars scalar");
my @has_chars = $font->has_chars(string=>"\x01A");
ok(!$has_chars[0], "has_chars list 0");
ok($has_chars[1], "has_chars list 1");
}
ok(1, "end");
|
