t/t36oofont.t

   1 #!/usr/bin/perl -w
   2 use 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.)
  13 use Test::More tests => 20;
  14
  15 BEGIN { use_ok('Imager') };
  16
  17 init_log("testout/t36oofont.log", 1);
  18
  19 my $fontname_tt=$ENV{'TTFONTTEST'}||'./fontfiles/dodge.ttf';
  20 my $fontname_pfb=$ENV{'T1FONTTESTPFB'}||'./fontfiles/dcr10.pfb';
  21
  22
  23 my $green=Imager::Color->new(92,205,92,128);
  24 die $Imager::ERRSTR unless $green;
  25 my $red=Imager::Color->new(205, 92, 92, 255);
  26 die $Imager::ERRSTR unless $red;
  27
  28 SKIP:
  29 {
  30   i_has_format("t1") && -f $fontname_pfb
  31     or skip("T1lib missing or disabled", 8);
  32
  33   my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
  34
  35   my $font=Imager::Font->new(file=>$fontname_pfb,size=>25)
  36     or die $img->{ERRSTR};
  37
  38   ok(1, "created font");
  39
  40   ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
  41       "draw text");
  42   $img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green);
  43
  44   my $text="LLySja";
  45   my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
  46
  47   is(@bbox, 8, "bounding box list length");
  48
  49   $img->box(box=>\@bbox, color=>$green);
  50
  51   # "utf8" support
  52   $text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
  53   ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1,
  54                    overline=>1),
  55       "draw 'utf8' hand-encoded text");
  56
  57   ok($img->string(font=>$font, text=>$text, 'x'=>140, 'y'=>50, utf8=>1,
  58                    underline=>1, channel=>2),
  59       "channel 'utf8' hand-encoded text");
  60
  61  SKIP:
  62   {
  63     $] >= 5.006
  64       or skip("perl too old for native utf8", 2);
  65     eval q{$text = "A\x{2010}A"};
  66     ok($img->string(font=>$font, text=>$text, 'x'=>180, 'y'=>50,
  67                     strikethrough=>1),
  68        "draw native UTF8 text");
  69     ok($img->string(font=>$font, text=>$text, 'x'=>220, 'y'=>50, channel=>1),
  70        "channel native UTF8 text");
  71   }
  72
  73   ok($img->write(file=>"testout/t36oofont1.ppm", type=>'pnm'),
  74       "write t36oofont1.ppm")
  75     or print "# ",$img->errstr,"\n";
  76
  77 }
  78
  79 SKIP:
  80 {
  81   i_has_format("tt") && -f $fontname_tt
  82     or skip("FT1.x missing or disabled", 10);
  83
  84   my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
  85
  86   my $font=Imager::Font->new(file=>$fontname_tt,size=>25)
  87     or die $img->{ERRSTR};
  88
  89   ok(1, "create TT font object");
  90
  91   ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
  92       "draw text");
  93
  94   $img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green);
  95
  96   my $text="LLySja";
  97   my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
  98
  99   is(@bbox, 8, "bbox list size");
 100
 101   $img->box(box=>\@bbox, color=>$green);
 102
 103   $text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
 104   ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1),
 105       "draw hand-encoded UTF8 text");
 106
 107  SKIP:
 108   {
 109     $] >= 5.006
 110       or skip("perl too old for native utf8", 1);
 111     eval q{$text = "A\x{2010}A"};
 112     ok($img->string(font=>$font, text=>$text, 'x'=>200, 'y'=>50),
 113        "draw native UTF8 text");
 114   }
 115
 116   ok($img->write(file=>"testout/t36oofont2.ppm", type=>'pnm'),
 117       "write t36oofont2.ppm")
 118     or print "# ", $img->errstr,"\n";
 119
 120   ok($font->utf8, "make sure utf8 method returns true");
 121
 122   my $has_chars = $font->has_chars(string=>"\x01A");
 123   is($has_chars, "\x00\x01", "has_chars scalar");
 124   my @has_chars = $font->has_chars(string=>"\x01A");
 125   ok(!$has_chars[0], "has_chars list 0");
 126   ok($has_chars[1], "has_chars list 1");
 127 }
 128
 129 ok(1, "end");