[RT #65863] mostly eliminate i_has_format
[imager.git] / t / t80texttools.t
1 #!perl -w
2 use strict;
3 use Test::More tests => 13;
4
5 BEGIN { use_ok('Imager') }
6
7 -d "testout" or mkdir "testout";
8
9 require_ok('Imager::Font::Wrap');
10
11 my $img = Imager->new(xsize=>400, ysize=>400);
12
13 my $text = <<EOS;
14 This is a test of text wrapping. This is a test of text wrapping. This =
15 is a test of text wrapping. This is a test of text wrapping. This is a =
16 test of text wrapping. This is a test of text wrapping. This is a test =
17 of text wrapping. This is a test of text wrapping. This is a test of =
18 text wrapping. XX.
19
20 Xxxxxxxxxxxxxxxxxxxxxxxxxxxwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww xxxx.
21
22 This is a test of text wrapping. This is a test of text wrapping. This =
23 is a test of text wrapping. This is a test of text wrapping. This is a =
24 test of text wrapping. This is a test of text wrapping. This is a test =
25 of text wrapping. This is a test of text wrapping. This is a test of =
26 text wrapping. This is a test of text wrapping. This is a test of text =
27 wrapping. This is a test of text wrapping. This is a test of text =
28 wrapping. This is a test of text wrapping. This is a test of text =
29 wrapping. This is a test of text wrapping. This is a test of text =
30 wrapping. XX.
31 EOS
32
33 $text =~ s/=\n//g;
34
35 my $fontfile = $ENV{WRAPTESTFONT} || $ENV{TTFONTTEST} || "fontfiles/ImUgly.ttf";
36
37 my $font = Imager::Font->new(file=>$fontfile);
38
39 SKIP:
40 {
41   $Imager::formats{'tt'} || $Imager::formats{'ft2'}
42       or skip("Need Freetype 1.x or 2.x to test", 11);
43
44   ok($font, "loading font")
45     or skip("Could not load test font", 8);
46
47   Imager::Font->priorities(qw(t1 ft2 tt));
48   ok(scalar Imager::Font::Wrap->wrap_text(string => $text,
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");
57   ok($img->write(file=>'testout/t80wrapped.ppm'), "save to file");
58   ok(scalar Imager::Font::Wrap->wrap_text(string => $text,
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);
68   ok($bbox, "get height for check");
69
70   my $used;
71   ok(scalar Imager::Font::Wrap->wrap_text
72       (string=>$text, font=>$font, image=>undef, size=>13, width=>380,
73        savepos=> \$used, height => $bbox->font_height), "savepos call");
74   ok($used > 20 && $used < length($text), "savepos value");
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
80   ok(@box == 4, "bounds list count");
81   print "# @box\n";
82   ok($box[3] == $bbox->font_height, "check height");
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   }
94 }