I'm trying to change some pixel's color in a PNG file. As a test, the following script should read a (256x256) PNG file, draw a red diagonal on it, and write the resulting image to file. There's a diagonal alright, but it's white. What am I missing?
#!/usr/bin/env perl
use GD;
$in_file = "in_file.png";
open($PNG,"<$in_file");
$im = newFromPng GD::Image($PNG) or die "Cannot open $in_file for importing";
close($PNG);
$red = $im->colorAllocate(255,0,0);
for($i=0;$i<256;$i++) {
$im->setPixel($i,$i,$red);
}
$out_file = "out_file.png";
open($IF,">$out_file") or die "Cannot open $out_file for writing?";
binmode $IF;
print $IF $im->png();
close($IF);
The problem is that the color table in the image is full so colorAllocate fails (and returns -1).
You shouldn't really use colorAllocate on an existing palette based image anyway since the color may already exist in the color table.
If you don't wish to add a new color, you could instead use colorClosest(255,0,0) - but that may give you a color far from what you wanted.
A better option is often colorResolve(255,0,0) that will try to find an exact match for the color in the existing table or add it if it's missing.
In your case however, you can't add the missing color and there is no red in the 256 colors already existing.
One option is to sacrifise the color that is closest to red and simply make it red.
Example:
#!/usr/bin/env perl
use strict;
use warnings;
use GD;
sub forceAllocate {
my ($im, $wr, $wg, $wb) = @_; # wanted color
my $color = $im->colorResolve($wr, $wg, $wb);
my ($gr,$gg,$gb) = $im->rgb($color); # gotten color
if ($wr != $gr || $wg != $gg || $wb != $gb) {
# the wanted color doesn't exist and the color table is full
# deallocate the color we got (which is the closest to the wanted)
$im->colorDeallocate($color);
# and now allocate the one we want
$color = $im->colorAllocate($wr, $wg, $wb);
die "something went wrong" if($color == -1);
}
return $color;
}
my $in_file = "in_file.png";
my $im = GD::Image->newFromPng($in_file) or die "$in_file: $!";
my $red = forceAllocate($im, 255, 0, 0);
printf "red: $red\n"; # print the index of our color
for(my $i=0; $i<256; $i++) {
$im->setPixel($i, $i, $red);
}
my $out_file = "out_file.png";
open(my $IF,'>', $out_file) or die "$out_file: $!";
binmode $IF;
print $IF $im->png();
close($IF);
Note though that if the replaced color is used a lot, this could change the appearance drastically. You may instead want to look though the image to find the color least used and replace that color instead. I'll leave that up to you.
Another option could be to convert the png to use truecolor instead of a color table of only 256 colors. This will let you use up to ~16 million colors in the same picture. Here colorAllocate doesn't fail, since there is no color table to fill. Note that this operation will increase the size of the resulting image considerably.
Example:
#!/usr/bin/env perl
use strict;
use warnings;
use GD;
my $in_file = "in_file.png";
my $old = GD::Image->newFromPng($in_file) or die "$in_file: $!";
my ($x, $y) = $old->getBounds();
# create a truecolor image
my $im = GD::Image->new($x, $y, 1); # the '1' means truecolor
# and copy the original image into the truecolor image:
$im->copy($old, 0,0, 0,0, $x, $y);
my $red = $im->colorAllocate(255, 0, 0);
printf "red: $red\n";
for(my $i=0; $i<256; $i++) {
$im->setPixel($i, $i, $red);
}
my $out_file = "out_file.png";
open(my $IF,'>', $out_file) or die "Cannot open $out_file for writing?";
binmode $IF;
print $IF $im->png();
close($IF);
Apparently, newFromPng has a second $truecolor argument ($image = GD::Image->newFromPng($file, [$truecolor])) "... to specify if the return image should be palette-based or truecolor" but my GD version doesn't seem to support that. If that works for you, you don't have to create a new image and copy the old image into that. Instead you could just do:
my $im = GD::Image->newFromPng($in_file, 1) or die "$in_file: $!";
my $red = $im->colorAllocate(255, 0, 0);