t/t106tiff.t

   1 print "1..13\n";
   2 use Imager qw(:all);
   3 $^W=1; # warnings during command-line tests
   4 $|=1;  # give us some progress in the test harness
   5 init_log("testout/t106tiff.log",1);
   6
   7 $green=i_color_new(0,255,0,255);
   8 $blue=i_color_new(0,0,255,255);
   9 $red=i_color_new(255,0,0,255);
  10
  11 $img=Imager::ImgRaw::new(150,150,3);
  12
  13 i_box_filled($img,70,25,130,125,$green);
  14 i_box_filled($img,20,25,80,125,$blue);
  15 i_arc($img,75,75,30,0,361,$red);
  16 i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
  17
  18 my $timg = Imager::ImgRaw::new(20, 20, 4);
  19 my $trans = i_color_new(255, 0, 0, 127);
  20 i_box_filled($timg, 0, 0, 20, 20, $green);
  21 i_box_filled($timg, 2, 2, 18, 18, $trans);
  22
  23 if (!i_has_format("tiff")) {
  24   for (1..13) {
  25     print "ok $_ # skip no tiff support\n";
  26   }
  27 } else {
  28   open(FH,">testout/t106.tiff") || die "cannot open testout/t10.tiff for writing\n";
  29   binmode(FH);
  30   my $IO = Imager::io_new_fd(fileno(FH));
  31   i_writetiff_wiol($img, $IO);
  32   close(FH);
  33
  34   print "ok 1\n";
  35
  36   open(FH,"testout/t106.tiff") or die "cannot open testout/t106.tiff\n";
  37   binmode(FH);
  38   $IO = Imager::io_new_fd(fileno(FH));
  39   $cmpimg = i_readtiff_wiol($IO, -1);
  40
  41   close(FH);
  42
  43   print "# tiff average mean square pixel difference: ",sqrt(i_img_diff($img,$cmpimg))/150*150,"\n";
  44   print "ok 2\n";
  45
  46   i_img_diff($img, $cmpimg) and print "not ";
  47   print "ok 3\n";
  48
  49   $IO = Imager::io_new_bufchain();
  50
  51   Imager::i_writetiff_wiol($img, $IO) or die "Cannot write to bufferchain\n";
  52   my $tiffdata = Imager::io_slurp($IO);
  53
  54   open(FH,"testout/t106.tiff");
  55   my $odata;
  56   { local $/;
  57     $odata = <FH>;
  58   }
  59
  60   if ($odata eq $tiffdata) {
  61     print "ok 4\n";
  62   } else {
  63     print "not ok 4\n";
  64   }
  65
  66   # test Micksa's tiff writer
  67   # a shortish fax page
  68   my $faximg = Imager::ImgRaw::new(1728, 2000, 1);
  69   my $black = i_color_new(0,0,0,255);
  70   my $white = i_color_new(255,255,255,255);
  71   # vaguely test-patterny
  72   i_box_filled($faximg, 0, 0, 1728, 2000, $white);
  73   i_box_filled($faximg, 100,100,1628, 200, $black);
  74   my $width = 1;
  75   my $pos = 100;
  76   while ($width+$pos < 1628) {
  77     i_box_filled($faximg, $pos, 300, $pos+$width-1, 400, $black);
  78     $pos += $width + 20;
  79     $width += 2;
  80   }
  81   open FH, "> testout/t106tiff_fax.tiff"
  82     or die "Cannot create testout/t106tiff_fax.tiff: $!";
  83   binmode FH;
  84   $IO = Imager::io_new_fd(fileno(FH));
  85   i_writetiff_wiol_faxable($faximg, $IO, 1)
  86     or print "not ";
  87   print "ok 5\n";
  88   close FH;
  89
  90   # test the OO interface
  91   my $ooim = Imager->new;
  92   $ooim->read(file=>'testout/t106.tiff')
  93     or print "not ";
  94   print "ok 6\n";
  95   $ooim->write(file=>'testout/t106_oo.tiff')
  96     or print "not ";
  97   print "ok 7\n";
  98
  99   # OO with the fax image
 100   my $oofim = Imager->new;
 101   $oofim->read(file=>'testout/t106tiff_fax.tiff')
 102     or print "not ";
 103   print "ok 8\n";
 104   $oofim->write(file=>'testout/t106_oo_fax.tiff', class=>'fax')
 105     or print "not ";
 106   print "ok 9\n";
 107
 108   # the following should fail since there's no type and no filename
 109   my $oodata;
 110   $ooim->write(data=>\$oodata)
 111     and print "not ";
 112   print "ok 10\n";
 113
 114   # OO to data
 115   $ooim->write(data=>\$oodata, type=>'tiff')
 116     or print 'not ';
 117   print "ok 11\n";
 118   $oodata eq $tiffdata or print "not ";
 119   print "ok 12\n";
 120
 121   # make sure we can write non-fine mode
 122   $oofim->write(file=>'testout/t106_oo_faxlo.tiff', class=>'fax', fax_fine=>0)
 123     or print "not ";
 124   print "ok 13\n";
 125 }
 126