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 }