t/t37w32font.t

   1 #!perl -w
   2 use strict;
   3 use lib 't';
   4 use Test::More tests => 7;
   5 BEGIN { use_ok(Imager => ':all') }
   6
   7 init_log("testout/t37w32font.log",1);
   8
   9 SKIP:
  10 {
  11   i_has_format('w32') or skip("no MS Windows", 6);
  12   print "# has w32\n";
  13
  14   my $fontname=$ENV{'TTFONTTEST'} || 'Times New Roman Bold';
  15
  16   # i_init_fonts(); # unnecessary for Win32 font support
  17
  18   my $bgcolor=i_color_new(255,0,0,0);
  19   my $overlay=Imager::ImgRaw::new(200,70,3);
  20
  21   my @bbox=Imager::i_wf_bbox($fontname, 50.0,'XMCLH');
  22   print "#bbox: ($bbox[0], $bbox[1]) - ($bbox[2], $bbox[3])\n";
  23
  24   ok(Imager::i_wf_cp($fontname,$overlay,5,50,1,50.0,'XMCLH',1,1),
  25      "i_wf_cp smoke test");
  26   i_line($overlay,0,50,100,50,$bgcolor, 1);
  27
  28   open(FH,">testout/t37w32font.ppm") || die "cannot open testout/t37w32font.ppm\n";
  29   binmode(FH);
  30   my $io = Imager::io_new_fd(fileno(FH));
  31   i_writeppm_wiol($overlay,$io);
  32   close(FH);
  33
  34   $bgcolor=i_color_set($bgcolor,200,200,200,0);
  35   my $backgr=Imager::ImgRaw::new(500,300,3);
  36
  37   ok(Imager::i_wf_text($fontname,$backgr,100,100,$bgcolor,100,'MAW.',1, 1),
  38      "i_wf_text smoke test");
  39   i_line($backgr,0, 100, 499, 100, NC(0, 0, 255), 1);
  40
  41   open(FH,">testout/t37w32font2.ppm") || die "cannot open testout/t37w32font2.ppm\n";
  42   binmode(FH);
  43   $io = Imager::io_new_fd(fileno(FH));
  44   i_writeppm_wiol($backgr,$io);
  45   close(FH);
  46
  47   my $img = Imager->new(xsize=>200, ysize=>200);
  48   my $font = Imager::Font->new(face=>$fontname, size=>20);
  49   ok($img->string('x'=>30, 'y'=>30, string=>"Imager", color=>NC(255, 0, 0),
  50                font=>$font),
  51      "string with win32 smoke test")
  52     or print "# ",$img->errstr,"\n";
  53   $img->write(file=>'testout/t37_oo.ppm') or print "not ";
  54   my @bbox2 = $font->bounding_box(string=>'Imager');
  55   is(@bbox2, 6, "got 6 values from bounding_box");
  56
  57   # this only applies while the Win32 driver returns 6 values
  58   # at this point we don't return the advance width from the low level
  59   # bounding box function, so the Imager::Font::BBox advance method should
  60   # return end_offset, check it does
  61   my $bbox = $font->bounding_box(string=>"some text");
  62   ok($bbox, "got the bounding box object");
  63   is($bbox->advance_width, $bbox->end_offset,
  64      "check advance_width fallback correct");
  65 }