[RT #65863] mostly eliminate i_has_format
[imager.git] / t / t80texttools.t
CommitLineData
64f9ab49 1#!perl -w
3799c4d1 2use strict;
7febff1d 3use Test::More tests => 13;
3799c4d1 4
64f9ab49 5BEGIN { use_ok('Imager') }
3799c4d1 6
40e78f96
TC
7-d "testout" or mkdir "testout";
8
64f9ab49 9require_ok('Imager::Font::Wrap');
3799c4d1
TC
10
11my $img = Imager->new(xsize=>400, ysize=>400);
12
13my $text = <<EOS;
14This is a test of text wrapping. This is a test of text wrapping. This =
15is a test of text wrapping. This is a test of text wrapping. This is a =
16test of text wrapping. This is a test of text wrapping. This is a test =
17of text wrapping. This is a test of text wrapping. This is a test of =
18text wrapping. XX.
19
20Xxxxxxxxxxxxxxxxxxxxxxxxxxxwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww xxxx.
21
22This is a test of text wrapping. This is a test of text wrapping. This =
23is a test of text wrapping. This is a test of text wrapping. This is a =
24test of text wrapping. This is a test of text wrapping. This is a test =
25of text wrapping. This is a test of text wrapping. This is a test of =
26text wrapping. This is a test of text wrapping. This is a test of text =
27wrapping. This is a test of text wrapping. This is a test of text =
28wrapping. This is a test of text wrapping. This is a test of text =
29wrapping. This is a test of text wrapping. This is a test of text =
30wrapping. XX.
31EOS
32
33$text =~ s/=\n//g;
34
35my $fontfile = $ENV{WRAPTESTFONT} || $ENV{TTFONTTEST} || "fontfiles/ImUgly.ttf";
36
37my $font = Imager::Font->new(file=>$fontfile);
38
64f9ab49
TC
39SKIP:
40{
2368cfec 41 $Imager::formats{'tt'} || $Imager::formats{'ft2'}
7febff1d 42 or skip("Need Freetype 1.x or 2.x to test", 11);
64f9ab49
TC
43
44 ok($font, "loading font")
45 or skip("Could not load test font", 8);
3799c4d1 46
3799c4d1 47 Imager::Font->priorities(qw(t1 ft2 tt));
64f9ab49 48 ok(scalar Imager::Font::Wrap->wrap_text(string => $text,
3799c4d1
TC
49 font=>$font,
50 image=>$img,
51 size=>13,
52 width => 380, aa=>1,
53 x=>10, 'y'=>10,
54 justify=>'fill',
55 color=>'FFFFFF'),
56 "basic test");
64f9ab49
TC
57 ok($img->write(file=>'testout/t80wrapped.ppm'), "save to file");
58 ok(scalar Imager::Font::Wrap->wrap_text(string => $text,
3799c4d1
TC
59 font=>$font,
60 image=>undef,
61 size=>13,
62 width => 380,
63 x=>10, 'y'=>10,
64 justify=>'left',
65 color=>'FFFFFF'),
66 "no image test");
67 my $bbox = $font->bounding_box(string=>"Xx", size=>13);
64f9ab49 68 ok($bbox, "get height for check");
3799c4d1
TC
69
70 my $used;
64f9ab49 71 ok(scalar Imager::Font::Wrap->wrap_text
3799c4d1
TC
72 (string=>$text, font=>$font, image=>undef, size=>13, width=>380,
73 savepos=> \$used, height => $bbox->font_height), "savepos call");
64f9ab49 74 ok($used > 20 && $used < length($text), "savepos value");
3799c4d1
TC
75 print "# $used\n";
76 my @box = Imager::Font::Wrap->wrap_text
77 (string=>substr($text, 0, $used), font=>$font, image=>undef, size=>13,
78 width=>380);
79
64f9ab49 80 ok(@box == 4, "bounds list count");
3799c4d1 81 print "# @box\n";
64f9ab49 82 ok($box[3] == $bbox->font_height, "check height");
7febff1d
TC
83
84 { # regression
85 # http://rt.cpan.org/Ticket/Display.html?id=29771
86 # the length of the trailing line wasn't included in the text consumed
87 my $used;
88 ok(scalar Imager::Font::Wrap->wrap_text
89 ( string => "test", font => $font, image => undef, size => 12,
90 width => 200, savepos => \$used, height => $bbox->font_height),
91 "regression 29771 - call wrap_text");
92 is($used, 4, "all text should be consumed");
93 }
3799c4d1 94}