16935c4134c0027e25cd4b637cf8ddb43dd24c78
[imager.git] / 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 => 13;
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 ok((-d "testout" or mkdir "testout"), "make output directory");
17
18 Imager::init_log("testout/t20oo.log", 1);
19
20 my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
21
22 my $font=Imager::Font->new(file=>$fontname_pfb,size=>25, type => "t1")
23   or die $img->{ERRSTR};
24
25 ok(1, "created font");
26
27 ok($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
31 my $text="LLySja";
32 my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
33
34 is(@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);
40 ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1,
41                 overline=>1),
42    "draw 'utf8' hand-encoded text");
43
44 ok($img->string(font=>$font, text=>$text, 'x'=>140, 'y'=>50, utf8=>1, 
45                 underline=>1, channel=>2),
46    "channel 'utf8' hand-encoded text");
47
48 SKIP:
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
60 ok($img->write(file=>"testout/t36oofont1.ppm", type=>'pnm'),
61    "write t36oofont1.ppm")
62   or print "# ",$img->errstr,"\n";
63
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
83 unless ($ENV{IMAGER_KEEP_FILES}) {
84   unlink "testout/t36oofont1.ppm";
85 }