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