[RT #65863] mostly eliminate i_has_format
[imager.git] / t / t36oofont.t
CommitLineData
02d1d628
AMH
1#!/usr/bin/perl -w
2use strict;
3
4#use lib qw(blib/lib blib/arch);
5
6# Before `make install' is performed this script should be runnable with
7# `make test'. After `make install' it should work as `perl test.pl'
8
9######################### We start with some black magic to print on failure.
10
11# Change 1..1 below to 1..last_test_to_print .
12# (It may become useful if the test is moved to ./t subdirectory.)
a556912d 13use Test::More tests => 12;
02d1d628 14
64f9ab49 15BEGIN { use_ok('Imager') };
02d1d628 16
40e78f96
TC
17-d "testout" or mkdir "testout";
18
02d1d628
AMH
19init_log("testout/t36oofont.log", 1);
20
21my $fontname_tt=$ENV{'TTFONTTEST'}||'./fontfiles/dodge.ttf';
02d1d628
AMH
22
23my $green=Imager::Color->new(92,205,92,128);
24die $Imager::ERRSTR unless $green;
25my $red=Imager::Color->new(205, 92, 92, 255);
26die $Imager::ERRSTR unless $red;
27
64f9ab49
TC
28SKIP:
29{
2368cfec 30 $Imager::formats{"tt"} && -f $fontname_tt
64f9ab49 31 or skip("FT1.x missing or disabled", 10);
02d1d628
AMH
32
33 my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
34
35 my $font=Imager::Font->new(file=>$fontname_tt,size=>25)
36 or die $img->{ERRSTR};
37
64f9ab49 38 ok(1, "create TT font object");
02d1d628 39
64f9ab49 40 ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
4f68b48f 41 "draw text");
02d1d628
AMH
42
43 $img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green);
44
45 my $text="LLySja";
46 my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
47
64f9ab49 48 is(@bbox, 8, "bbox list size");
02d1d628
AMH
49
50 $img->box(box=>\@bbox, color=>$green);
51
4f68b48f 52 $text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
64f9ab49 53 ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1),
4f68b48f
TC
54 "draw hand-encoded UTF8 text");
55
64f9ab49
TC
56 SKIP:
57 {
58 $] >= 5.006
59 or skip("perl too old for native utf8", 1);
4f68b48f 60 eval q{$text = "A\x{2010}A"};
64f9ab49 61 ok($img->string(font=>$font, text=>$text, 'x'=>200, 'y'=>50),
4f68b48f
TC
62 "draw native UTF8 text");
63 }
4f68b48f 64
64f9ab49 65 ok($img->write(file=>"testout/t36oofont2.ppm", type=>'pnm'),
4f68b48f
TC
66 "write t36oofont2.ppm")
67 or print "# ", $img->errstr,"\n";
68
64f9ab49 69 ok($font->utf8, "make sure utf8 method returns true");
02d1d628 70
eeaa33fd 71 my $has_chars = $font->has_chars(string=>"\x01A");
5386861e 72 is($has_chars, "\x00\x01", "has_chars scalar");
eeaa33fd 73 my @has_chars = $font->has_chars(string=>"\x01A");
64f9ab49
TC
74 ok(!$has_chars[0], "has_chars list 0");
75 ok($has_chars[1], "has_chars list 1");
02d1d628
AMH
76}
77
64f9ab49 78ok(1, "end");