t/t80texttools.t

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