t/t80texttools.t

   1 use strict;
   2 my $loaded;
   3 BEGIN {
   4   require "t/testtools.pl";
   5   $| = 1; print "1..11\n";
   6 }
   7 END { okx(0, "loading") unless $loaded; }
   8 use Imager;
   9 $loaded = 1;
  10
  11 okx(1, "Loaded");
  12
  13 requireokx("Imager/Font/Wrap.pm", "load basic wrapping");
  14
  15 my $img = Imager->new(xsize=>400, ysize=>400);
  16
  17 my $text = <<EOS;
  18 This is a test of text wrapping. This is a test of text wrapping. This =
  19 is a test of text wrapping. This is a test of text wrapping. This is a =
  20 test of text wrapping. This is a test of text wrapping. This is a test =
  21 of text wrapping. This is a test of text wrapping. This is a test of =
  22 text wrapping. XX.
  23
  24 Xxxxxxxxxxxxxxxxxxxxxxxxxxxwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww xxxx.
  25
  26 This is a test of text wrapping. This is a test of text wrapping. This =
  27 is a test of text wrapping. This is a test of text wrapping. This is a =
  28 test of text wrapping. This is a test of text wrapping. This is a test =
  29 of text wrapping. This is a test of text wrapping. This is a test of =
  30 text wrapping. This is a test of text wrapping. This is a test of text =
  31 wrapping. This is a test of text wrapping. This is a test of text =
  32 wrapping. This is a test of text wrapping. This is a test of text =
  33 wrapping. This is a test of text wrapping. This is a test of text =
  34 wrapping. XX.
  35 EOS
  36
  37 $text =~ s/=\n//g;
  38
  39 my $fontfile = $ENV{WRAPTESTFONT} || $ENV{TTFONTTEST} || "fontfiles/ImUgly.ttf";
  40
  41 my $font = Imager::Font->new(file=>$fontfile);
  42
  43 unless (Imager::i_has_format('tt') || Imager::i_has_format('ft2')) {
  44   skipx(9, "Need Freetype 1.x or 2.x to test");
  45   exit;
  46 }
  47
  48 if (okx($font, "loading font")) {
  49   Imager::Font->priorities(qw(t1 ft2 tt));
  50   okx(scalar Imager::Font::Wrap->wrap_text(string => $text,
  51                                 font=>$font,
  52                                 image=>$img,
  53                                 size=>13,
  54                                 width => 380, aa=>1,
  55                                 x=>10, 'y'=>10,
  56                                 justify=>'fill',
  57                                 color=>'FFFFFF'),
  58       "basic test");
  59   okx($img->write(file=>'testout/t80wrapped.ppm'), "save to file");
  60   okx(scalar Imager::Font::Wrap->wrap_text(string => $text,
  61                                 font=>$font,
  62                                 image=>undef,
  63                                 size=>13,
  64                                 width => 380,
  65                                 x=>10, 'y'=>10,
  66                                 justify=>'left',
  67                                 color=>'FFFFFF'),
  68       "no image test");
  69   my $bbox = $font->bounding_box(string=>"Xx", size=>13);
  70   okx($bbox, "get height for check");
  71
  72   my $used;
  73   okx(scalar Imager::Font::Wrap->wrap_text
  74       (string=>$text, font=>$font, image=>undef, size=>13, width=>380,
  75        savepos=> \$used, height => $bbox->font_height), "savepos call");
  76   okx($used > 20 && $used < length($text), "savepos value");
  77   print "# $used\n";
  78   my @box = Imager::Font::Wrap->wrap_text
  79     (string=>substr($text, 0, $used), font=>$font, image=>undef, size=>13,
  80      width=>380);
  81
  82   okx(@box == 4, "bounds list count");
  83   print "# @box\n";
  84   okx($box[3] == $bbox->font_height, "check height");
  85 }
  86 else {
  87   skipx(8, "Could not load test font");
  88 }