view release on metacpan or  search on metacpan

W32/t/t10win32.t  view on Meta::CPAN

#!perl -w
use strict;
use Test::More tests => 59;
use Imager qw(:all);
use Imager::Test qw(diff_text_with_nul isnt_image);
++$|;

ok(-d "testout" or mkdir("testout"), "testout directory");

ok($Imager::formats{w32}, "\$formats{w32} populated");

init_log("testout/t10w32font.log",1);

SKIP:
{
  print "# has w32\n";

  my $fontname=$ENV{'TTFONTTEST'} || 'Times New Roman Bold';
  
  # i_init_fonts(); # unnecessary for Win32 font support

  my $bgcolor=i_color_new(255,0,0,0);
  my $overlay=Imager::ImgRaw::new(200,70,3);
  
  my @bbox=Imager::Font::W32::i_wf_bbox($fontname, 50.0,'XMCLH');
  print "#bbox: ($bbox[0], $bbox[1]) - ($bbox[2], $bbox[3])\n";
  
  ok(Imager::Font::W32::i_wf_cp($fontname,$overlay,5,50,1,50.0,'XMCLH',1,1),
     "i_wf_cp smoke test");
  i_line($overlay,0,50,100,50,$bgcolor, 1);
  
  if (open(FH,">testout/t10font.ppm")) {
    binmode(FH);
    my $io = Imager::io_new_fd(fileno(FH));
    i_writeppm_wiol($overlay,$io);
    close(FH);
  }
  else {
    diag "cannot open testout/t10font.ppm: $!";
  }
  
  $bgcolor=i_color_set($bgcolor,200,200,200,255);
  my $backgr=Imager::ImgRaw::new(500,300,3);
  
  ok(Imager::Font::W32::i_wf_text($fontname,$backgr,100,100,$bgcolor,100,'MAW.',1, 1),
     "i_wf_text smoke test");
  i_line($backgr,0, 100, 499, 100, NC(0, 0, 255), 1);
  
  if (open(FH,">testout/t10font2.ppm")) {
    binmode(FH);
    my $io = Imager::io_new_fd(fileno(FH));
    i_writeppm_wiol($backgr,$io);
    close(FH);
  }
  else {
    diag "cannot open testout/t10font2.ppm: $!";
  }

  my $img = Imager->new(xsize=>200, ysize=>200);
  my $font = Imager::Font->new(face=>$fontname, size=>20);
  ok($img->string('x'=>30, 'y'=>30, string=>"Imager", color=>NC(255, 0, 0), 
	       font=>$font),
     "string with win32 smoke test")
    or diag "simple string output: ",$img->errstr;
  $img->write(file=>'testout/t10_oo.ppm')
    or diag "Cannot save t10_oo.ppm: ", $img->errstr;
  my @bbox2 = $font->bounding_box(string=>'Imager');
  is(@bbox2, 8, "got 8 values from bounding_box");

  # this only applies while the Win32 driver returns 6 values
  # at this point we don't return the advance width from the low level
  # bounding box function, so the Imager::Font::BBox advance method should
  # return end_offset, check it does
  my $bbox = $font->bounding_box(string=>"some text");
  ok($bbox, "got the bounding box object");
  is($bbox->advance_width, $bbox->end_offset, 
     "check advance_width fallback correct");

 SKIP:
  {
    $^O eq 'cygwin' and skip("Too hard to get correct directory for test font on cygwin", 13);
    my $extra_font = "fontfiles/ExistenceTest.ttf";
    unless (ok(Imager::Font::W32::i_wf_addfont($extra_font), "add test font")) {
      diag "adding font resource: ",Imager::_error_as_msg();
      skip("Could not add font resource", 12);
    }
    
    my $namefont = Imager::Font->new(face=>"ExistenceTest");
    ok($namefont, "create font based on added font");
    
    # the test font is known to have a shorter advance width for that char
    @bbox = $namefont->bounding_box(string=>"/", size=>100);
    print "# / box: @bbox\n";
    is(@bbox, 8, "should be 8 entries");
    isnt($bbox[6], $bbox[2], "different advance width");