#!/usr/bin/perl -w
use strict;
use Imager;
use Imager::Test qw(isnt_image);
use Test::More tests => 14;
# extracted from t/t36oofont.t
my $fontname_pfb = "fontfiles/dcr10.pfb";
my $green=Imager::Color->new(92,205,92,128);
die $Imager::ERRSTR unless $green;
my $red=Imager::Color->new(205, 92, 92, 255);
die $Imager::ERRSTR unless $red;
-d "testout" or mkdir "testout";
ok(-d "testout", "make output directory");
Imager::init_log("testout/t20oo.log", 1);
my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
my $font=Imager::Font->new(file=>$fontname_pfb,size=>25, type => "t1")
or die $img->{ERRSTR};
ok(1, "created font");
ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
"draw text");
$img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green);
my $text="LLySja";
my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
is(@bbox, 8, "bounding box list length");
$img->box(box=>\@bbox, color=>$green);
# "utf8" support
$text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1,
overline=>1),
"draw 'utf8' hand-encoded text");
ok($img->string(font=>$font, text=>$text, 'x'=>140, 'y'=>50, utf8=>1,
underline=>1, channel=>2),
"channel 'utf8' hand-encoded text");
SKIP:
{
$] >= 5.006
or skip("perl too old for native utf8", 2);
eval q{$text = "A\x{2010}A"};
ok($img->string(font=>$font, text=>$text, 'x'=>180, 'y'=>50,
strikethrough=>1),
"draw native UTF8 text");
ok($img->string(font=>$font, text=>$text, 'x'=>220, 'y'=>50, channel=>1),
"channel native UTF8 text");
}
ok($img->write(file=>"testout/t36oofont1.ppm", type=>'pnm'),
"write t36oofont1.ppm")
or print "# ",$img->errstr,"\n";
{ # RT 71469
my $font1 = Imager::Font->new(file => $fontname_pfb, type => "t1");
my $font2 = Imager::Font::T1->new(file => $fontname_pfb);
for my $font ($font1, $font2) {
print "# ", join(",", $font->{color}->rgba), "\n";
my $im = Imager->new(xsize => 20, ysize => 20, channels => 4);
ok($im->string(text => "T", font => $font, y => 15),
"draw with default color")
or print "# ", $im->errstr, "\n";
my $work = Imager->new(xsize => 20, ysize => 20);
my $cmp = $work->copy;
$work->rubthrough(src => $im);
isnt_image($work, $cmp, "make sure something was drawn");
}
}
{ # open a non-font as a font (test open failure)
local $ENV{LANG} = "C";
local $ENV{LC_ALL} = "C";
my $font = Imager::Font->new(file => "t/t20oo.t", type => "t1");
ok(!$font, "should fail to open test script as a font");
print "# ", Imager->errstr, "\n";
}
unless ($ENV{IMAGER_KEEP_FILES}) {
unlink "testout/t36oofont1.ppm";
}