From: Tony Cook Date: Tue, 15 Aug 2006 08:12:30 +0000 (+0000) Subject: added pixel type 'index' to getscanline() and setscanline() for X-Git-Tag: Imager-0.54~16 X-Git-Url: http://git.imager.perl.org/imager.git/commitdiff_plain/4cda4e766fd2cfec4646c996787a1ed6941cfb3e added pixel type 'index' to getscanline() and setscanline() for getting/setting palette indexes from paletted images. https://rt.cpan.org/Ticket/Display.html?id=20338 --- diff --git a/Imager.pm b/Imager.pm index 154e6e8d..e4ae9bf8 100644 --- 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; diff --git a/Imager.xs b/Imager.xs index 479bdaa6..d929c208 100644 --- 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 6f312f70..7e5587fb 100644 --- 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 diff --git a/lib/Imager/Draw.pod b/lib/Imager/Draw.pod index fca9fc0d..925facc1 100644 --- a/lib/Imager/Draw.pod +++ b/lib/Imager/Draw.pod @@ -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 is C then this can either be a reference to an array +of palette color indexes or a scalar containing packed indexes. + See L 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. +Permited values are C<8bit> and C and C. =back In list context this method will return a list of Imager::Color objects when I is C<8bit>, or a list of Imager::Color::Float -objects when I if C. +objects when I if C, or a list of integers when I +is C. In scalar context this returns a packed 8-bit pixels when I is C<8bit>, or a list of packed floating point pixels when I is -C. +C, or packed palette color indexes when I is C. 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 template: my $packed_float_pixel = pack("dddd", $red, $blue, $green, $alpha); +If you use a I parameter of C 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 diff --git a/t/t023palette.t b/t/t023palette.t index c28ecb74..6faad048 100644 --- a/t/t023palette.t +++ b/t/t023palette.t @@ -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(<