getting/setting palette indexes from paletted images.
https://rt.cpan.org/Ticket/Display.html?id=20338
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.
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'}) {
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'");
my $self = shift;
my %opts = ( x=>0, @_);
+ $self->_valid_image or return;
+
unless (defined $opts{'y'}) {
$self->_set_error("missing y parameter");
return;
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;
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
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);
}
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
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
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.
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.
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
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
# 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");
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) = @_;
}
}
+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) = @_;
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: