]> git.imager.perl.org - imager.git/commitdiff
added pixel type 'index' to getscanline() and setscanline() for
authorTony Cook <tony@develop=help.com>
Tue, 15 Aug 2006 08:12:30 +0000 (08:12 +0000)
committerTony Cook <tony@develop=help.com>
Tue, 15 Aug 2006 08:12:30 +0000 (08:12 +0000)
getting/setting palette indexes from paletted images.

https://rt.cpan.org/Ticket/Display.html?id=20338

Imager.pm
Imager.xs
TODO
lib/Imager/Draw.pod
t/t023palette.t
t/t67convert.t

index 154e6e8dd98c42f132f1d88a2669383611ed3bd3..e4ae9bf87b42ab97b43b9ba0678c5a7b3399c429 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -552,6 +552,15 @@ sub _color {
   return $result;
 }
 
+sub _valid_image {
+  my ($self) = @_;
+
+  $self->{IMG} and return 1;
+
+  $self->_set_error('empty input image');
+
+  return;
+}
 
 #
 # Methods to be called on objects.
@@ -2837,6 +2846,8 @@ sub getscanline {
   my $self = shift;
   my %opts = ( type => '8bit', x=>0, @_);
 
+  $self->_valid_image or return;
+
   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
 
   unless (defined $opts{'y'}) {
@@ -2846,11 +2857,19 @@ sub getscanline {
 
   if ($opts{type} eq '8bit') {
     return i_glin($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
-                 $opts{y});
+                 $opts{'y'});
   }
   elsif ($opts{type} eq 'float') {
     return i_glinf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
-                 $opts{y});
+                 $opts{'y'});
+  }
+  elsif ($opts{type} eq 'index') {
+    unless (i_img_type($self->{IMG})) {
+      $self->_set_error("type => index only valid on paletted images");
+      return;
+    }
+    return i_gpal($self->{IMG}, $opts{x}, $opts{x} + $opts{width},
+                  $opts{'y'});
   }
   else {
     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
@@ -2862,6 +2881,8 @@ sub setscanline {
   my $self = shift;
   my %opts = ( x=>0, @_);
 
+  $self->_valid_image or return;
+
   unless (defined $opts{'y'}) {
     $self->_set_error("missing y parameter");
     return;
@@ -2903,6 +2924,14 @@ sub setscanline {
       return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
     }
   }
+  elsif ($opts{type} eq 'index') {
+    if (ref $opts{pixels}) {
+      return i_ppal($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
+    }
+    else {
+      return i_ppal_p($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
+    }
+  }
   else {
     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
     return;
index 479bdaa6b5a5b882559ccadc4d1ea025d72517ad..d929c20811798801fcec69a9d5b8ce4d85402291 100644 (file)
--- a/Imager.xs
+++ b/Imager.xs
@@ -814,6 +814,29 @@ load_fount_segs(AV *asegs, int *count) {
   return segs;
 }
 
+/* validates the indexes supplied to i_ppal
+
+i_ppal() doesn't do that for speed, but I'm not comfortable doing that
+for calls from perl.
+
+*/
+static void
+validate_i_ppal(i_img *im, i_palidx const *indexes, int count) {
+  int color_count = i_colorcount(im);
+  int i;
+
+  if (color_count == -1)
+    croak("i_plin() called on direct color image");
+  
+  for (i = 0; i < count; ++i) {
+    if (indexes[i] >= color_count) {
+      croak("i_plin() called with out of range color index %d (max %d)",
+        indexes[i], color_count-1);
+    }
+  }
+}
+
+
 /* I don't think ICLF_* names belong at the C interface
    this makes the XS code think we have them, to let us avoid 
    putting function bodies in the XS code
@@ -3536,12 +3559,15 @@ i_ppal(im, l, y, ...)
       PREINIT:
         i_palidx *work;
         int i;
+        STRLEN len;
+        int count;
       CODE:
         if (items > 3) {
           work = mymalloc(sizeof(i_palidx) * (items-3));
           for (i=0; i < items-3; ++i) {
             work[i] = SvIV(ST(i+3));
           }
+          validate_i_ppal(im, work, items - 3);
           RETVAL = i_ppal(im, l, l+items-3, y, work);
           myfree(work);
         }
@@ -3551,6 +3577,30 @@ i_ppal(im, l, y, ...)
       OUTPUT:
         RETVAL
 
+int
+i_ppal_p(im, l, y, data)
+        Imager::ImgRaw  im
+        int     l
+        int     y
+        SV *data
+      PREINIT:
+        i_palidx const *work;
+        int i;
+        STRLEN len;
+        int count;
+      CODE:
+        work = (i_palidx const *)SvPV(data, len);
+        len /= sizeof(i_palidx);
+        if (len > 0) {
+          validate_i_ppal(im, work, len);
+          RETVAL = i_ppal(im, l, l+len, y, work);
+        }
+        else {
+          RETVAL = 0;
+        }
+      OUTPUT:
+        RETVAL
+
 SV *
 i_addcolors(im, ...)
         Imager::ImgRaw  im
diff --git a/TODO b/TODO
index 6f312f702cb175f59b382ac9f99c785e6d87ddd1..7e5587fb38f69f5f6d2e44e1ab7b51212a75e483 100644 (file)
--- a/TODO
+++ b/TODO
@@ -8,9 +8,9 @@ not commitments.
 
 BEFORE 0.54
 
-OO interface for i_plin/i_glin
+OO interface for i_plin/i_glin (done)
 
-remove gif query from makefile.pl
+remove gif query from makefile.pl (done)
 
 fallback for read/write_multi to read/write
 
index fca9fc0d22812f28f80ed0c3b09a0e9e2419c46f..925facc118bc0f29e2da3fe36ef4678552033556 100644 (file)
@@ -749,6 +749,9 @@ pixels - either a reference to an array containing Imager::Color
 objects, an reference to an array containing Imager::Color::Float
 objects or a scalar containing packed color data.
 
+If C<type> is C<index> then this can either be a reference to an array
+of palette color indexes or a scalar containing packed indexes.
+
 See L</"Packed Color Data"> for information on the format of packed
 color data.
 
@@ -761,6 +764,9 @@ packed floating point color data then set this to 'float'.
 
 You can use float or 8bit samples with any image.
 
+If this is 'index' then pixels should be either an array of palette
+color indexes or a packed string of color indexes.
+
 =back
 
 Returns the number of pixels set.
@@ -834,17 +840,18 @@ width - number of pixels to read.  Default: $img->getwidth - x
 
 type - the type of pixel data to return.  Default: C<8bit>.
 
-Permited values are C<8bit> and C<float>.
+Permited values are C<8bit> and C<float> and C<index>.
 
 =back
 
 In list context this method will return a list of Imager::Color
 objects when I<type> is C<8bit>, or a list of Imager::Color::Float
-objects when I<type> if C<float>.
+objects when I<type> if C<float>, or a list of integers when I<type>
+is C<index>.
 
 In scalar context this returns a packed 8-bit pixels when I<type> is
 C<8bit>, or a list of packed floating point pixels when I<type> is
-C<float>.
+C<float>, or packed palette color indexes when I<type> is C<index>.
 
 The values of samples for which the image does not have channels is
 undefined.  For example, for a single channel image the values of
@@ -970,6 +977,16 @@ To produce packed double/sample pixels, use the pack C<d> template:
 
   my $packed_float_pixel = pack("dddd", $red, $blue, $green, $alpha);
 
+If you use a I<type> parameter of C<index> then the values are palette
+color indexes, not sample values:
+
+  my $im = Imager->new(xsize => 100, ysize => 100, type => 'paletted');
+  my $black_index = $im->addcolors(colors => [ 'black' ]);
+  my $red_index = $im->addcolors(colors => [ 'red' ]);
+  # 2 pixels
+  my $packed_index_data = pack("C*", $black_index, $red_index);
+  $im->setscanline(y => $y, pixels => $packed_index_data, type => 'index');
+
 =head1 BUGS
 
 box, arc, do not support antialiasing yet.  Arc, is only filled as of
index c28ecb743c99f670d55e0fe1524481a79ff8e677..6faad048df2415bdb2048666b20579c6010d04fe 100644 (file)
@@ -2,9 +2,11 @@
 # some of this is tested in t01introvert.t too
 use strict;
 use lib 't';
-use Test::More tests => 75;
+use Test::More tests => 83;
 BEGIN { use_ok("Imager"); }
 
+sub isbin($$$);
+
 my $img = Imager->new(xsize=>50, ysize=>50, type=>'paletted');
 
 ok($img, "paletted image created");
@@ -235,6 +237,37 @@ cmp_ok(Imager->errstr, '=~', qr/Channels must be positive and <= 4/,
   is($img->errstr, 'No color named XXFGXFXGXFXZ found', 'check error message');
 }
 
+{ # https://rt.cpan.org/Ticket/Display.html?id=20338
+  # OO interface to i_glin/i_plin
+  my $im = Imager->new(xsize => 10, ysize => 10, type => 'paletted');
+  is($im->addcolors(colors => [ "#000", "#F00", "#0F0", "#00F" ]), "0 but true",
+     "add some test colors")
+    or print "# ", $im->errstr, "\n";
+  # set a pixel to check
+  $im->setpixel(x => 1, 'y' => 0, color => "#0F0");
+  is_deeply([ $im->getscanline('y' => 0, type=>'index') ],
+            [ 0, 2, (0) x 8 ], "getscanline index in list context");
+  isbin($im->getscanline('y' => 0, type=>'index'),
+        "\x00\x02" . "\x00" x 8,
+        "getscanline index in scalar context");
+  is($im->setscanline('y' => 0, pixels => [ 1, 2, 0, 3 ], type => 'index'),
+     4, "setscanline with list");
+  is($im->setscanline('y' => 0, x => 4, pixels => pack("C*", 3, 2, 1, 0, 3),
+                      type => 'index'),
+     5, "setscanline with pv");
+  is_deeply([ $im->getscanline(type => 'index', 'y' => 0) ],
+            [ 1, 2, 0, 3, 3, 2, 1, 0, 3, 0 ],
+            "check values set");
+  eval { # should croak on OOR index
+    $im->setscanline('y' => 1, pixels => [ 255 ], type=>'index');
+  };
+  ok($@, "croak on setscanline() to invalid index");
+  eval { # same again with pv
+    $im->setscanline('y' => 1, pixels => "\xFF", type => 'index');
+  };
+  ok($@, "croak on setscanline() with pv to invalid index");
+}
+
 sub iscolor {
   my ($c1, $c2, $msg) = @_;
 
@@ -250,6 +283,20 @@ DIAG
   }
 }
 
+sub isbin ($$$) {
+  my ($got, $expected, $msg) = @_;
+
+  my $builder = Test::Builder->new;
+  if (!$builder->ok($got eq $expected, $msg)) {
+    (my $got_dec = $got) =~ s/([^ -~])/sprintf("\\x%02x", ord $1)/ge;
+    (my $exp_dec = $expected)  =~ s/([^ -~])/sprintf("\\x%02x", ord $1)/ge;
+    $builder->diag(<<DIAG);
+      got: "$got_dec"
+ expected: "$exp_dec"
+DIAG
+  }
+}
+
 sub coloreq {
   my ($left, $right, $comment) = @_;
 
index 466f676f1a9515b8752971f85138117cef3aa7f9..5b33032ad709726283b4fd4cd3deec92b70254a7 100644 (file)
@@ -73,7 +73,7 @@ my $black = NC(0, 0, 0);
 my $blackindex = Imager::i_addcolors($impal, $black);
 ok($blackindex, "add black to paletted");
 for my $y (0..299) {
-  Imager::i_ppal($impal, 0, $y, ($black) x 200);
+  Imager::i_ppal($impal, 0, $y, ($blackindex) x 200);
 }
 my $impalout = Imager::i_img_pal_new(200, 300, 3, 256);
 SKIP: