t/t36oofont.t

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 #use lib qw(blib/lib blib/arch);
   5
   6 # Before `make install' is performed this script should be runnable with
   7 # `make test'. After `make install' it should work as `perl test.pl'
   8
   9 ######################### We start with some black magic to print on failure.
  10
  11 # Change 1..1 below to 1..last_test_to_print .
  12 # (It may become useful if the test is moved to ./t subdirectory.)
  13 use Test::More tests => 16;
  14
  15 BEGIN { use_ok('Imager') };
  16
  17 BEGIN {
  18   require Imager::Test;
  19   Imager::Test->import(qw(isnt_image));
  20 }
  21
  22 -d "testout" or mkdir "testout";
  23
  24 Imager->open_log(log => "testout/t36oofont.log");
  25
  26 my $fontname_tt=$ENV{'TTFONTTEST'}||'./fontfiles/dodge.ttf';
  27
  28 my $green=Imager::Color->new(92,205,92,128);
  29 die $Imager::ERRSTR unless $green;
  30 my $red=Imager::Color->new(205, 92, 92, 255);
  31 die $Imager::ERRSTR unless $red;
  32
  33 SKIP:
  34 {
  35   $Imager::formats{"tt"} && -f $fontname_tt
  36     or skip("FT1.x missing or disabled", 14);
  37
  38   my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
  39
  40   my $font=Imager::Font->new(file=>$fontname_tt,size=>25)
  41     or die $img->{ERRSTR};
  42
  43   ok(1, "create TT font object");
  44
  45   ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
  46       "draw text");
  47
  48   $img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green);
  49
  50   my $text="LLySja";
  51   my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
  52
  53   is(@bbox, 8, "bbox list size");
  54
  55   $img->box(box=>\@bbox, color=>$green);
  56
  57   $text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
  58   ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1),
  59       "draw hand-encoded UTF8 text");
  60
  61  SKIP:
  62   {
  63     $] >= 5.006
  64       or skip("perl too old for native utf8", 1);
  65     eval q{$text = "A\x{2010}A"};
  66     ok($img->string(font=>$font, text=>$text, 'x'=>200, 'y'=>50),
  67        "draw native UTF8 text");
  68   }
  69
  70   ok($img->write(file=>"testout/t36oofont2.ppm", type=>'pnm'),
  71       "write t36oofont2.ppm")
  72     or print "# ", $img->errstr,"\n";
  73
  74   ok($font->utf8, "make sure utf8 method returns true");
  75
  76   my $has_chars = $font->has_chars(string=>"\x01A");
  77   is($has_chars, "\x00\x01", "has_chars scalar");
  78   my @has_chars = $font->has_chars(string=>"\x01A");
  79   ok(!$has_chars[0], "has_chars list 0");
  80   ok($has_chars[1], "has_chars list 1");
  81
  82   { # RT 71469
  83     my $font1 = Imager::Font->new(file => $fontname_tt, type => "tt");
  84     my $font2 = Imager::Font::Truetype->new(file => $fontname_tt);
  85
  86     for my $font ($font1, $font2) {
  87       print "# ", join(",", $font->{color}->rgba), "\n";
  88
  89       my $im = Imager->new(xsize => 20, ysize => 20, channels => 4);
  90
  91       ok($im->string(text => "T", font => $font, y => 15),
  92          "draw with default color")
  93         or print "# ", $im->errstr, "\n";
  94       my $work = Imager->new(xsize => 20, ysize => 20);
  95       my $cmp = $work->copy;
  96       $work->rubthrough(src => $im);
  97       isnt_image($work, $cmp, "make sure something was drawn");
  98     }
  99   }
 100 }
 101
 102 ok(1, "end");