]> git.imager.perl.org - imager.git/commitdiff
add tests for mono make_colors
authorTony Cook <tony@develop=help.com>
Mon, 12 Mar 2007 09:40:02 +0000 (09:40 +0000)
committerTony Cook <tony@develop=help.com>
Mon, 12 Mar 2007 09:40:02 +0000 (09:40 +0000)
TODO
t/t023palette.t

diff --git a/TODO b/TODO
index 618ee55f11e7ebe012953e1b9c9aec42381ad499..b24ce19ed865787c3d10817ab76dcc3e9ae43c0d 100644 (file)
--- a/TODO
+++ b/TODO
@@ -12,13 +12,13 @@ checking testing of new ft2 rendering
 
 possibly: use renderer on other fonts
 
-check testing of new ppm input
+check testing of new ppm input (done)
 
-check testing of new ppm output
+check testing of new ppm output (done)
 
 check lbr's font output issue
 
-tests for monochrome makemap
+tests for monochrome makemap (done)
 
 BEFORE 0.54
 
index aef127c50ccbc4ae1943382fb90852081a8f111e..b002de94d13f001f99a4250d6d33ba8e19d619e1 100644 (file)
@@ -1,7 +1,7 @@
 #!perl -w
 # some of this is tested in t01introvert.t too
 use strict;
-use Test::More tests => 83;
+use Test::More tests => 90;
 BEGIN { use_ok("Imager"); }
 
 sub isbin($$$);
@@ -267,6 +267,26 @@ cmp_ok(Imager->errstr, '=~', qr/Channels must be positive and <= 4/,
   ok($@, "croak on setscanline() with pv to invalid index");
 }
 
+{
+  print "# make_colors => mono\n";
+  # test mono make_colors
+  my $imrgb = Imager->new(xsize => 10, ysize => 10);
+  $imrgb->setpixel(x => 0, 'y' => 0, color => '#FFF');
+  $imrgb->setpixel(x => 1, 'y' => 0, color => '#FF0');
+  $imrgb->setpixel(x => 2, 'y' => 0, color => '#000');
+  my $mono = $imrgb->to_paletted(make_colors => 'mono',
+                                  translate => 'closest');
+  is($mono->type, 'paletted', "check we get right image type");
+  is($mono->colorcount, 2, "only 2 colors");
+  my @colors = $mono->getcolors;
+  iscolor($colors[0], $black, "check first entry");
+  iscolor($colors[1], $white, "check second entry");
+  my @pixels = $mono->getscanline(x => 0, 'y' => 0, width => 3, type=>'index');
+  is($pixels[0], 1, "check white pixel");
+  is($pixels[1], 1, "check yellow pixel");
+  is($pixels[2], 0, "check black pixel");
+}
+
 sub iscolor {
   my ($c1, $c2, $msg) = @_;