use strict;
use Test::More;
use Imager ':all';
-use Imager::Test qw(diff_text_with_nul is_color3);
+use Imager::Test qw(diff_text_with_nul is_color3 is_image isnt_image);
use Imager::Font::T1;
use Cwd qw(getcwd abs_path);
#$Imager::DEBUG=1;
-plan tests => 97;
+plan tests => 110;
ok($Imager::formats{t1}, "must have t1");
-ok((-d "testout" or mkdir "testout"), "make output directory");
+-d "testout" or mkdir "testout";
+ok(-d "testout", "make output directory");
init_log("testout/t10type1.log",1);
init(t1log=>0);
unlink "t1lib.log";
- my $fnum=Imager::Font::T1::i_t1_new($fontname_pfb,$fontname_afm); # this will load the pfb font
+ my $fnum=Imager::Font::T1xs->new($fontname_pfb,$fontname_afm); # this will load the pfb font
unless (ok($fnum >= 0, "load font $fontname_pfb")) {
skip("without the font I can't do a thing", 90);
}
- my $bgcolor=Imager::Color->new(255,0,0,0);
+ my $bgcolor=Imager::Color->new(255,0,0,255);
my $overlay=Imager::ImgRaw::new(200,70,3);
- ok(Imager::Font::T1::i_t1_cp($overlay,5,50,1,$fnum,50.0,'XMCLH',5,1), "i_t1_cp");
+ ok($fnum->cp($overlay,5,50,1,50.0,'XMCLH',1), "i_t1_cp");
i_line($overlay,0,50,100,50,$bgcolor,1);
- my @bbox=Imager::Font::T1::i_t1_bbox(0,50.0,'XMCLH',5);
+ my @bbox=$fnum->bbox(50.0,'XMCLH');
is(@bbox, 8, "i_t1_bbox");
print "# bbox: ($bbox[0], $bbox[1]) - ($bbox[2], $bbox[3])\n";
i_writeppm_wiol($overlay,$IO);
close(FH);
- $bgcolor=Imager::Color::set($bgcolor,200,200,200,0);
+ $bgcolor=Imager::Color::set($bgcolor,200,200,200,255);
my $backgr=Imager::ImgRaw::new(280,300,3);
- Imager::Font::T1::i_t1_set_aa(2);
- ok(Imager::Font::T1::i_t1_text($backgr,10,100,$bgcolor,$fnum,150.0,'test',4,1), "i_t1_text");
+ ok($fnum->text($backgr,10,100,$bgcolor,150.0,'test',1,2), "i_t1_text");
# "UTF8" tests
# for perl < 5.6 we can hand-encode text
my $text = pack("C*", 0x41, 0xC2, 0xA1, 0xE2, 0x80, 0x90, 0x41);
my $alttext = "A\xA1A";
- my @utf8box = Imager::Font::T1::i_t1_bbox($fnum, 50.0, $text, length($text), 1);
+ my @utf8box = $fnum->bbox(50.0, $text, 1);
is(@utf8box, 8, "utf8 bbox element count");
- my @base = Imager::Font::T1::i_t1_bbox($fnum, 50.0, $alttext, length($alttext), 0);
+ my @base = $fnum->bbox(50.0, $alttext, 0);
is(@base, 8, "alt bbox element count");
my $maxdiff = $fontname_pfb eq $deffont ? 0 : $base[2] / 3;
print "# (@utf8box vs @base)\n";
"compare box sizes $utf8box[2] vs $base[2] (maxerror $maxdiff)");
# hand-encoded UTF8 drawing
- ok(Imager::Font::T1::i_t1_text($backgr, 10, 140, $bgcolor, $fnum, 32, $text, length($text), 1,1), "draw hand-encoded UTF8");
+ ok($fnum->text($backgr, 10, 140, $bgcolor, 32, $text, 1,1), "draw hand-encoded UTF8");
- ok(Imager::Font::T1::i_t1_cp($backgr, 80, 140, 1, $fnum, 32, $text, length($text), 1, 1),
+ ok($fnum->cp($backgr, 80, 140, 1, 32, $text, 1, 1),
"cp hand-encoded UTF8");
+ { # invalid utf8
+ my $text = pack("C", 0xC0);
+ ok(!$fnum->text($backgr, 10, 140, $bgcolor, 32, $text, 1, 1),
+ "attempt to draw invalid utf8");
+ is(Imager->_error_as_msg, "invalid UTF8 character",
+ "check message");
+ }
+
# ok, try native perl UTF8 if available
SKIP:
{
# versions
eval q{$text = "A\xA1\x{2010}A"}; # A, a with ogonek, HYPHEN, A in our test font
#$text = "A".chr(0xA1).chr(0x2010)."A"; # this one works too
- ok(Imager::Font::T1::i_t1_text($backgr, 10, 180, $bgcolor, $fnum, 32, $text, length($text), 1),
+ Imager->log("draw UTF8\n");
+ ok($fnum->text($backgr, 10, 180, $bgcolor, 32, $text, 1),
"draw UTF8");
- ok(Imager::Font::T1::i_t1_cp($backgr, 80, 180, 1, $fnum, 32, $text, length($text), 1),
+ ok($fnum->cp($backgr, 80, 180, 1, 32, $text, 1),
"cp UTF8");
- @utf8box = Imager::Font::T1::i_t1_bbox($fnum, 50.0, $text, length($text), 0);
+ @utf8box = $fnum->bbox(50.0, $text, 0);
is(@utf8box, 8, "native utf8 bbox element count");
ok(abs($utf8box[2] - $base[2]) <= $maxdiff,
"compare box sizes native $utf8box[2] vs $base[2] (maxerror $maxdiff)");
eval q{$text = "A\xA1\xA2\x01\x1F\x{0100}A"};
- ok(Imager::Font::T1::i_t1_text($backgr, 10, 220, $bgcolor, $fnum, 32, $text, 0, 1, 0, "uso"),
+ ok($fnum->text($backgr, 10, 220, $bgcolor, 32, $text, 0, 1, "uso"),
"more complex output");
}
i_writeppm_wiol($backgr, $IO);
close(FH);
- my $rc=Imager::Font::T1::i_t1_destroy($fnum);
- unless (ok($rc >= 0, "i_t1_destroy")) {
- print "# i_t1_destroy failed: rc=$rc\n";
- }
-
- print "# debug: ",join(" x ",Imager::Font::T1::i_t1_bbox(0,50,"eses",4) ),"\n";
- print "# debug: ",join(" x ",Imager::Font::T1::i_t1_bbox(0,50,"llll",4) ),"\n";
+ undef $fnum;
# character existance tests - uses the special ExistenceTest font
my $exists_font = 'fontfiles/ExistenceTest.pfb';
-e $exists_font or die "$exists_font not found";
- my $font_num = Imager::Font::T1::i_t1_new($exists_font, $exists_afm);
+ my $font_num = Imager::Font::T1xs->new($exists_font, $exists_afm);
SKIP: {
ok($font_num >= 0, 'loading test font')
or skip('Could not load test font', 6);
# first the list interface
- my @exists = Imager::Font::T1::i_t1_has_chars($font_num, "!A");
+ my @exists = $font_num->has_chars("!A");
is(@exists, 2, "return count from has_chars");
ok($exists[0], "we have an exclamation mark");
ok(!$exists[1], "we have no uppercase A");
# then the scalar interface
- my $exists = Imager::Font::T1::i_t1_has_chars($font_num, "!A");
+ my $exists = $font_num->has_chars("!A");
is(length($exists), 2, "return scalar length");
ok(ord(substr($exists, 0, 1)), "we have an exclamation mark");
ok(!ord(substr($exists, 1, 1)), "we have no upper-case A");
- Imager::Font::T1::i_t1_destroy($font_num);
+ undef $font_num;
}
my $font = Imager::Font->new(file=>$exists_font, type=>'t1');
isnt($bbox[2], $bbox[5], "different advance to pos_width");
# names
- my $face_name = Imager::Font::T1::i_t1_face_name($font->{id});
+ my $face_name = $font->{t1font}->face_name();
print "# face $face_name\n";
is($face_name, 'ExistenceTest', "face name");
$face_name = $font->face_name;
ok($font, "found font by drive relative path")
or print "# path $drive_path\n";
}
+
+ {
+ Imager->log("Testing aa levels", 1);
+ my $f1 = Imager::Font->new(file => $deffont, type => "t1");
+ is($f1->{t1aa}, 2, "should have default aa level");
+ my $imbase = Imager->new(xsize => 100, ysize => 20);
+ ok($imbase->string(text => "test", size => 18, x => 5, y => 18,
+ color => "#FFF", font => $f1, aa => 1),
+ "draw text with def aa level");
+ ok(Imager::Font::T1->set_aa_level(1), "set aa level to 1");
+ my $f2 = Imager::Font->new(file => $deffont, type => "t1");
+ is($f2->{t1aa}, 1, "new font has new aa level");
+ my $imaa1 = Imager->new(xsize => 100, ysize => 20);
+ ok($imaa1->string(text => "test", size => 18, x => 5, y => 18,
+ color => "#FFF", font => $f2, aa => 1),
+ "draw text with non-def aa level");
+ isnt_image($imbase, $imaa1, "images should differ");
+ ok($f2->set_aa_level(2), "set aa level of font");
+ is($f2->{t1aa}, 2, "check new aa level");
+ my $imaa2 = Imager->new(xsize => 100, ysize => 20);
+ ok($imaa2->string(text => "test", size => 18, x => 5, y => 18,
+ color => "#FFF", font => $f2, aa => 1),
+ "draw text with non-def but 2 aa level");
+ is_image($imbase, $imaa2, "check images match");
+ }
+
+ { # error handling check
+ my $im = Imager->new(xsize => 100, ysize => 20);
+ my $fnum = Imager::Font->new(file => $deffont, type => "t1");
+ ok(!$im->string(font => $fnum, string => "text", size => -10),
+ "set invalid size");
+ is($im->errstr, "i_t1_text(): T1_AASetString failed: Invalid Argument in Function Call",
+ "check error message");
+ }
}
+
#malloc_state();
+
projects / imager.git / blobdiff