135 lines
3.9 KiB
Perl
135 lines
3.9 KiB
Perl
#!/usr/bin/perl
|
|
#
|
|
# This code was forked from the LiveJournal project owned and operated
|
|
# by Live Journal, Inc. The code has been modified and expanded by
|
|
# Dreamwidth Studios, LLC. These files were originally licensed under
|
|
# the terms of the license supplied by Live Journal, Inc, which can
|
|
# currently be found at:
|
|
#
|
|
# http://code.livejournal.org/trac/livejournal/browser/trunk/LICENSE-LiveJournal.txt
|
|
#
|
|
# In accordance with the original license, this code and all its
|
|
# modifications are provided under the GNU General Public License.
|
|
# A copy of that license can be found in the LICENSE file included as
|
|
# part of this distribution.
|
|
|
|
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;
|