t/t106tiff.t

   1 print "1..4\n";
   2 use Imager qw(:all);
   3
   4 init_log("testout/t105gif.log",1);
   5
   6 $green=i_color_new(0,255,0,255);
   7 $blue=i_color_new(0,0,255,255);
   8 $red=i_color_new(255,0,0,255);
   9
  10 $img=Imager::ImgRaw::new(150,150,3);
  11
  12 i_box_filled($img,70,25,130,125,$green);
  13 i_box_filled($img,20,25,80,125,$blue);
  14 i_arc($img,75,75,30,0,361,$red);
  15 i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
  16
  17 my $timg = Imager::ImgRaw::new(20, 20, 4);
  18 my $trans = i_color_new(255, 0, 0, 127);
  19 i_box_filled($timg, 0, 0, 20, 20, $green);
  20 i_box_filled($timg, 2, 2, 18, 18, $trans);
  21
  22 if (!i_has_format("tiff")) {
  23   print "ok 1 # skip no tiff support\n";
  24   print "ok 2 # skip no tiff support\n";
  25   print "ok 3 # skip no tiff support\n";
  26 } else {
  27   open(FH,">testout/t10.tiff") || die "cannot open testout/t10.tiff for writing\n";
  28   binmode(FH);
  29   my $IO = Imager::io_new_fd(fileno(FH));
  30   i_writetiff_wiol($img, $IO);
  31   close(FH);
  32
  33   print "ok 1\n";
  34
  35   open(FH,"testout/t10.tiff") or die "cannot open testout/t10.tiff\n";
  36   binmode(FH);
  37   $IO = Imager::io_new_fd(fileno(FH));
  38   $cmpimg = i_readtiff_wiol($IO, -1);
  39
  40   close(FH);
  41
  42   print "# tiff average mean square pixel difference: ",sqrt(i_img_diff($img,$cmpimg))/150*150,"\n";
  43   print "ok 2\n";
  44
  45   $IO = Imager::io_new_bufchain();
  46
  47   Imager::i_writetiff_wiol($img, $IO) or die "Cannot write to bufferchain\n";
  48   my $tiffdata = Imager::io_slurp($IO);
  49
  50   open(FH,"testout/t10.tiff");
  51   my $odata;
  52   { local $/;
  53     $odata = <FH>;
  54   }
  55
  56   if ($odata eq $tiffdata) {
  57     print "ok 3\n";
  58   } else {
  59     print "not ok 3\n";
  60   }
  61
  62   # test Micksa's tiff writer
  63   # a shortish fax page
  64   my $faximg = Imager::ImgRaw::new(1728, 2000, 1);
  65   my $black = i_color_new(0,0,0,255);
  66   my $white = i_color_new(255,255,255,255);
  67   # vaguely test-patterny
  68   i_box_filled($faximg, 0, 0, 1728, 2000, $white);
  69   i_box_filled($faximg, 100,100,1628, 200, $black);
  70   my $width = 1;
  71   my $pos = 100;
  72   while ($width+$pos < 1628) {
  73     i_box_filled($faximg, $pos, 300, $pos+$width-1, 400, $black);
  74     $pos += $width + 20;
  75     $width += 2;
  76   }
  77   open FH, "> testout/t106tiff_fax.tiff"
  78     or die "Cannot create testout/t106tiff_fax.tiff: $!";
  79   binmode FH;
  80   $IO = Imager::io_new_fd(fileno(FH));
  81   i_writetiff_wiol_faxable($faximg, $IO)
  82     or print "not ";
  83   print "ok 4\n";
  84   close FH;
  85 }
  86