t/350-font/100-texttools.t

   1 #!perl -w
   2 use strict;
   3 use Test::More tests => 14;
   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", 12);
  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   ok(scalar Imager::Font::Wrap->wrap_text(string => $text,
  68                                 font=>$font,
  69                                 size=>13,
  70                                 width => 380,
  71                                 x=>10, 'y'=>10,
  72                                 justify=>'left',
  73                                 color=>'FFFFFF'),
  74       "no image parameter test");
  75   my $bbox = $font->bounding_box(string=>"Xx", size=>13);
  76   ok($bbox, "get height for check");
  77
  78   my $used;
  79   ok(scalar Imager::Font::Wrap->wrap_text
  80       (string=>$text, font=>$font, image=>undef, size=>13, width=>380,
  81        savepos=> \$used, height => $bbox->font_height), "savepos call");
  82   ok($used > 20 && $used < length($text), "savepos value");
  83   print "# $used\n";
  84   my @box = Imager::Font::Wrap->wrap_text
  85     (string=>substr($text, 0, $used), font=>$font, image=>undef, size=>13,
  86      width=>380);
  87
  88   ok(@box == 4, "bounds list count");
  89   print "# @box\n";
  90   ok($box[3] == $bbox->font_height, "check height");
  91
  92   { # regression
  93     # http://rt.cpan.org/Ticket/Display.html?id=29771
  94     # the length of the trailing line wasn't included in the text consumed
  95     my $used;
  96     ok(scalar Imager::Font::Wrap->wrap_text
  97        ( string => "test", font => $font, image => undef, size => 12,
  98          width => 200, savepos => \$used, height => $bbox->font_height),
  99        "regression 29771 - call wrap_text");
 100     is($used, 4, "all text should be consumed");
 101   }
 102 }