T1/t/t20oo.t

   1 #!/usr/bin/perl -w
   2 use strict;
   3 use Imager;
   4 use Imager::Test qw(isnt_image);
   5 use Test::More tests => 14;
   6
   7 # extracted from t/t36oofont.t
   8
   9 my $fontname_pfb = "fontfiles/dcr10.pfb";
  10
  11 my $green=Imager::Color->new(92,205,92,128);
  12 die $Imager::ERRSTR unless $green;
  13 my $red=Imager::Color->new(205, 92, 92, 255);
  14 die $Imager::ERRSTR unless $red;
  15
  16 -d "testout" or mkdir "testout";
  17 ok(-d "testout", "make output directory");
  18
  19 Imager::init_log("testout/t20oo.log", 1);
  20
  21 my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
  22
  23 my $font=Imager::Font->new(file=>$fontname_pfb,size=>25, type => "t1")
  24   or die $img->{ERRSTR};
  25
  26 ok(1, "created font");
  27
  28 ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
  29    "draw text");
  30 $img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green);
  31
  32 my $text="LLySja";
  33 my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
  34
  35 is(@bbox, 8, "bounding box list length");
  36
  37 $img->box(box=>\@bbox, color=>$green);
  38
  39 # "utf8" support
  40 $text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
  41 ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1,
  42                 overline=>1),
  43    "draw 'utf8' hand-encoded text");
  44
  45 ok($img->string(font=>$font, text=>$text, 'x'=>140, 'y'=>50, utf8=>1,
  46                 underline=>1, channel=>2),
  47    "channel 'utf8' hand-encoded text");
  48
  49 SKIP:
  50 {
  51   $] >= 5.006
  52     or skip("perl too old for native utf8", 2);
  53     eval q{$text = "A\x{2010}A"};
  54   ok($img->string(font=>$font, text=>$text, 'x'=>180, 'y'=>50,
  55                   strikethrough=>1),
  56      "draw native UTF8 text");
  57   ok($img->string(font=>$font, text=>$text, 'x'=>220, 'y'=>50, channel=>1),
  58      "channel native UTF8 text");
  59 }
  60
  61 ok($img->write(file=>"testout/t36oofont1.ppm", type=>'pnm'),
  62    "write t36oofont1.ppm")
  63   or print "# ",$img->errstr,"\n";
  64
  65 { # RT 71469
  66   my $font1 = Imager::Font->new(file => $fontname_pfb, type => "t1");
  67   my $font2 = Imager::Font::T1->new(file => $fontname_pfb);
  68
  69   for my $font ($font1, $font2) {
  70     print "# ", join(",", $font->{color}->rgba), "\n";
  71
  72     my $im = Imager->new(xsize => 20, ysize => 20, channels => 4);
  73
  74     ok($im->string(text => "T", font => $font, y => 15),
  75        "draw with default color")
  76       or print "# ", $im->errstr, "\n";
  77     my $work = Imager->new(xsize => 20, ysize => 20);
  78     my $cmp = $work->copy;
  79     $work->rubthrough(src => $im);
  80     isnt_image($work, $cmp, "make sure something was drawn");
  81   }
  82 }
  83
  84 { # open a non-font as a font (test open failure)
  85   local $ENV{LANG} = "C";
  86   local $ENV{LC_ALL} = "C";
  87   my $font = Imager::Font->new(file => "t/t20oo.t", type => "t1");
  88   ok(!$font, "should fail to open test script as a font");
  89   print "# ", Imager->errstr, "\n";
  90 }
  91
  92 unless ($ENV{IMAGER_KEEP_FILES}) {
  93   unlink "testout/t36oofont1.ppm";
  94 }