Well, if execution time can be sacrificed...
As you already found, Imager (through libpng) uses zlib's level 6, which is "good enough", because zlib's max (9) delivers compression only marginally better. But we can beat this "level 9" using more robust algorithm.
use strict;
use warnings;
use feature 'say';
use Imager;
use Image::PNG::Rewriter;
use IO::Compress::Deflate 'deflate', ':constants';
use Compress::Zopfli::ZLIB 'compress';
my $name = 'PNG_transparency_demonstration_1.png';
open my $fh, '<', $name;
binmode $fh;
Imager-> new( fh => $fh )
-> write( type => 'png', data => \my $png_imager );
seek $fh, 0, 0;
my $rw = Image::PNG::Rewriter-> new(
handle => $fh,
zlib => sub {
my $input = shift;
deflate \$input => \my $output,
-Level => 9,
-Strategy => Z_FILTERED;
return $output
}
);
$rw-> refilter( $rw-> original_filters ); # no-op
my $png_zlib9 = $rw-> as_png;
seek $fh, 0, 0;
$rw = Image::PNG::Rewriter-> new(
handle => $fh,
zlib => \&compress,
);
$rw-> refilter( $rw-> original_filters ); # no-op
my $png_zopfli = $rw-> as_png;
my $f = "%-24s%s\n";
printf $f, 'Original file', -s $name;
printf $f, 'Re-saved with Imager', length $png_imager;
printf $f, 'Compressed with zlib', length $png_zlib9;
printf $f, 'Compressed with zopfli', length $png_zopfli;
__END__
Original file 179559
Re-saved with Imager 203632
Compressed with zlib 198642
Compressed with zopfli 179618
The test subject is this image. Note the change history (disregard early versions, they are of low quality) -- last guy who uploaded final copy was, perhaps, using same Zopfli compressor.
I'm lazy to handle IDAT chunk(s) by hand, so there's Image::PNG::Rewriter DIY used. To kick-start compressor (passed as sub to constructor), it looks like some "is_dirty" flag needs to be set, or otherwise original IDAT is output as it was. Hence, the "no_op" line above, which filters scan-lines with the same values as original. I didn't investigate if Zopfli parameters can deliver (a) better compression or (b) faster execution with almost the same compression.
Heh, BTW, we can check if libpng is smart enough to find out itself, which filter to use with each scan-line:
use strict;
use warnings;
use feature 'say';
use Imager;
use Image::PNG::Rewriter;
my $i = Imager-> new(
# defaults are RGB, 8 bits per channel
xsize => 256,
ysize => 2,
filetype => 'raw',
interleave => 1, # RRRR...GGGG...BBBB...
data => \( pack 'C*',
( 0 .. 255 ) x 3, # 1st scanline is gradient
( 0 ) x ( 3 * 256 )), # 2nd scanline is flat black
) or die;
$i-> write( data => \my $png, type => 'png' );
open my $fh, '<', \$png;
my $re = Image::PNG::Rewriter-> new( handle => $fh );
say for $re-> original_filters;
__END__
1
0
BTW, all of the above is assuming, that you are working with true-color 24 bpp images, which cannot be (losslessly) converted to 8 bpp palletized PNG images.
|