Skip to content

Commit

Permalink
added pixel type 'index' to getscanline() and setscanline() for
Browse files Browse the repository at this point in the history 
getting/setting palette indexes from paletted images.

https://rt.cpan.org/Ticket/Display.html?id=20338
  • Loading branch information
Tony Cook committed Aug 15, 2006
1 parent 66dd085 commit 4cda4e7
Show file tree
Hide file tree
Showing 6 changed files with 152 additions and 9 deletions.
33 changes: 31 additions & 2 deletions Imager.pm
View file
Expand Up @@ -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.
Expand Down Expand Up @@ -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'}) {
Expand All @@ -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'");
Expand All @@ -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;
Expand Down Expand Up @@ -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;
Expand Down
50 changes: 50 additions & 0 deletions Imager.xs
View file
Expand Up @@ -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
Expand Down Expand Up @@ -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);
}
Expand All @@ -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
Expand Down
4 changes: 2 additions & 2 deletions TODO
View file
Expand Up @@ -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

Expand Down
23 changes: 20 additions & 3 deletions lib/Imager/Draw.pod
View file
Expand Up @@ -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.

Expand All @@ -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.
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
49 changes: 48 additions & 1 deletion t/t023palette.t
View file
Expand Up @@ -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");
Expand Down Expand Up @@ -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) = @_;

Expand All @@ -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) = @_;

Expand Down
2 changes: 1 addition & 1 deletion t/t67convert.t
View file
Expand Up @@ -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:
Expand Down

0 comments on commit 4cda4e7

Please sign in to comment.