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
|
#!perl -w
use strict;
use Test::More tests => 13;
BEGIN { use_ok('Imager') }
require_ok('Imager::Font::Wrap');
my $img = Imager->new(xsize=>400, ysize=>400);
my $text = <<EOS;
This is a test of text wrapping. This is a test of text wrapping. This =
is a test of text wrapping. This is a test of text wrapping. This is a =
test of text wrapping. This is a test of text wrapping. This is a test =
of text wrapping. This is a test of text wrapping. This is a test of =
text wrapping. XX.
Xxxxxxxxxxxxxxxxxxxxxxxxxxxwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww xxxx.
This is a test of text wrapping. This is a test of text wrapping. This =
is a test of text wrapping. This is a test of text wrapping. This is a =
test of text wrapping. This is a test of text wrapping. This is a test =
of text wrapping. This is a test of text wrapping. This is a test of =
text wrapping. This is a test of text wrapping. This is a test of text =
wrapping. This is a test of text wrapping. This is a test of text =
wrapping. This is a test of text wrapping. This is a test of text =
wrapping. This is a test of text wrapping. This is a test of text =
wrapping. XX.
EOS
$text =~ s/=\n//g;
my $fontfile = $ENV{WRAPTESTFONT} || $ENV{TTFONTTEST} || "fontfiles/ImUgly.ttf";
my $font = Imager::Font->new(file=>$fontfile);
SKIP:
{
Imager::i_has_format('tt') || Imager::i_has_format('ft2')
or skip("Need Freetype 1.x or 2.x to test", 11);
ok($font, "loading font")
or skip("Could not load test font", 8);
Imager::Font->priorities(qw(t1 ft2 tt));
ok(scalar Imager::Font::Wrap->wrap_text(string => $text,
font=>$font,
image=>$img,
size=>13,
width => 380, aa=>1,
x=>10, 'y'=>10,
justify=>'fill',
color=>'FFFFFF'),
"basic test");
ok($img->write(file=>'testout/t80wrapped.ppm'), "save to file");
ok(scalar Imager::Font::Wrap->wrap_text(string => $text,
font=>$font,
image=>undef,
size=>13,
width => 380,
x=>10, 'y'=>10,
justify=>'left',
color=>'FFFFFF'),
"no image test");
my $bbox = $font->bounding_box(string=>"Xx", size=>13);
ok($bbox, "get height for check");
my $used;
ok(scalar Imager::Font::Wrap->wrap_text
(string=>$text, font=>$font, image=>undef, size=>13, width=>380,
savepos=> \$used, height => $bbox->font_height), "savepos call");
ok($used > 20 && $used < length($text), "savepos value");
print "# $used\n";
my @box = Imager::Font::Wrap->wrap_text
(string=>substr($text, 0, $used), font=>$font, image=>undef, size=>13,
width=>380);
ok(@box == 4, "bounds list count");
print "# @box\n";
ok($box[3] == $bbox->font_height, "check height");
{ # regression
# http://rt.cpan.org/Ticket/Display.html?id=29771
# the length of the trailing line wasn't included in the text consumed
my $used;
ok(scalar Imager::Font::Wrap->wrap_text
( string => "test", font => $font, image => undef, size => 12,
width => 200, savepos => \$used, height => $bbox->font_height),
"regression 29771 - call wrap_text");
is($used, 4, "all text should be consumed");
}
}
|
