123 lines
3.2 KiB
Perl
Executable File
123 lines
3.2 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
|
|
use strict;
|
|
BEGIN {
|
|
$PaletteModify::HAVE_CRC = eval "use String::CRC32 (); 1;";
|
|
}
|
|
|
|
package PaletteModify;
|
|
|
|
sub common_alter
|
|
{
|
|
my ($palref, $table) = @_;
|
|
my $length = length $table;
|
|
|
|
my $pal_size = $length / 3;
|
|
|
|
# tinting image? if so, we're remaking the whole palette
|
|
if (my $tint = $palref->{'tint'}) {
|
|
my $dark = $palref->{'tint_dark'};
|
|
my $diff = [ map { $tint->[$_] - $dark->[$_] } (0..2) ];
|
|
$palref = {};
|
|
for (my $idx=0; $idx<$pal_size; $idx++) {
|
|
for my $c (0..2) {
|
|
my $curr = ord(substr($table, $idx*3+$c));
|
|
my $p = \$palref->{$idx}->[$c];
|
|
$$p = int($dark->[$c] + $diff->[$c] * $curr / 255);
|
|
}
|
|
}
|
|
}
|
|
|
|
while (my ($idx, $c) = each %$palref) {
|
|
next if $idx >= $pal_size;
|
|
substr($table, $idx*3+$_, 1) = chr($c->[$_]) for (0..2);
|
|
}
|
|
|
|
return $table;
|
|
}
|
|
|
|
sub new_gif_palette
|
|
{
|
|
my ($fh, $palref) = @_;
|
|
my $header;
|
|
|
|
# 13 bytes for magic + image info (size, color depth, etc)
|
|
# and then the global palette table (3*256)
|
|
read($fh, $header, 13+3*256);
|
|
|
|
# figure out how big global color table is (don't want to overwrite it)
|
|
my $pf = ord substr($header, 10, 1);
|
|
my $gct = 2 ** (($pf & 7) + 1); # last 3 bits of packaged fields
|
|
|
|
substr($header, 13, 3*$gct) = common_alter($palref, substr($header, 13, 3*$gct));
|
|
return $header;
|
|
}
|
|
|
|
sub new_png_palette
|
|
{
|
|
my ($fh, $palref) = @_;
|
|
|
|
# without this module, we can't proceed.
|
|
return undef unless $PaletteModify::HAVE_CRC;
|
|
|
|
my $imgdata;
|
|
|
|
# Validate PNG signature
|
|
my $png_sig = pack("H16", "89504E470D0A1A0A");
|
|
my $sig;
|
|
read($fh, $sig, 8);
|
|
return undef unless $sig eq $png_sig;
|
|
$imgdata .= $sig;
|
|
|
|
# Start reading in chunks
|
|
my ($length, $type) = (0, '');
|
|
while (read($fh, $length, 4)) {
|
|
|
|
$imgdata .= $length;
|
|
$length = unpack("N", $length);
|
|
return undef unless read($fh, $type, 4) == 4;
|
|
$imgdata .= $type;
|
|
|
|
if ($type eq 'IHDR') {
|
|
my $header;
|
|
read($fh, $header, $length+4);
|
|
my ($width,$height,$depth,$color,$compression,
|
|
$filter,$interlace, $CRC)
|
|
= unpack("NNCCCCCN", $header);
|
|
return undef unless $color == 3; # unpaletted image
|
|
$imgdata .= $header;
|
|
} elsif ($type eq 'PLTE') {
|
|
# Finally, we can go to work
|
|
my $palettedata;
|
|
read($fh, $palettedata, $length);
|
|
$palettedata = common_alter($palref, $palettedata);
|
|
$imgdata .= $palettedata;
|
|
|
|
# Skip old CRC
|
|
my $skip;
|
|
read($fh, $skip, 4);
|
|
|
|
# Generate new CRC
|
|
my $crc = String::CRC32::crc32($type . $palettedata);
|
|
$crc = pack("N", $crc);
|
|
|
|
$imgdata .= $crc;
|
|
return $imgdata;
|
|
} else {
|
|
my $skip;
|
|
# Skip rest of chunk and add to imgdata
|
|
# Number of bytes is +4 becauses of CRC
|
|
#
|
|
for (my $count=0; $count < $length + 4; $count++) {
|
|
read($fh, $skip, 1);
|
|
$imgdata .= $skip;
|
|
}
|
|
}
|
|
}
|
|
|
|
return undef;
|
|
}
|
|
|
|
1;
|