123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161 |
- #!/usr/bin/perl
- # Variation of the QOI encoder, combined with Zstandard compression.
- # See also:
- # https://qoiformat.org/
- # https://github.com/phoboslab/qoi
- use 5.020;
- use warnings;
- use Imager;
- use experimental qw(signatures);
- use IO::Compress::Zstd qw(zstd $ZstdError);
- sub qzst_encoder ($img, $out_fh) {
- use constant {
- QOI_OP_RGB => 0b1111_1110,
- QOI_OP_RGBA => 0b1111_1111,
- QOI_OP_DIFF => 0b01_000_000,
- QOI_OP_RUN => 0b11_000_000,
- QOI_OP_LUMA => 0b10_000_000,
- };
- my $width = $img->getwidth;
- my $height = $img->getheight;
- my $channels = $img->getchannels;
- my $colorspace = 0;
- say "[$width, $height, $channels, $colorspace]";
- my @header = unpack('C*', 'qzst');
- push @header, unpack('C4', pack('N', $width));
- push @header, unpack('C4', pack('N', $height));
- push @header, $channels;
- push @header, $colorspace;
- my $qoi_data = '';
- my $run = 0;
- my @px = (0, 0, 0, 255);
- my @prev_px = @px;
- my @colors = (map { [0, 0, 0, 0] } 1 .. 64);
- foreach my $y (0 .. $height - 1) {
- my @line = unpack('C*', scalar $img->getscanline(y => $y));
- my $line_len = scalar(@line);
- for (my $i = 0 ; $i < $line_len ; $i += 4) {
- @px = splice(@line, 0, 4);
- if ( $px[0] == $prev_px[0]
- and $px[1] == $prev_px[1]
- and $px[2] == $prev_px[2]
- and $px[3] == $prev_px[3]) {
- if (++$run == 62) {
- $qoi_data .= chr(QOI_OP_RUN | ($run - 1));
- $run = 0;
- }
- }
- else {
- if ($run > 0) {
- $qoi_data .= chr(QOI_OP_RUN | ($run - 1));
- $run = 0;
- }
- my $hash = ($px[0] * 3 + $px[1] * 5 + $px[2] * 7 + $px[3] * 11) % 64;
- my $index_px = $colors[$hash];
- if ( $px[0] == $index_px->[0]
- and $px[1] == $index_px->[1]
- and $px[2] == $index_px->[2]
- and $px[3] == $index_px->[3]) { # OP INDEX
- $qoi_data .= chr($hash);
- }
- else {
- $colors[$hash] = [@px];
- if ($px[3] == $prev_px[3]) {
- my $vr = $px[0] - $prev_px[0];
- my $vg = $px[1] - $prev_px[1];
- my $vb = $px[2] - $prev_px[2];
- my $vg_r = $vr - $vg;
- my $vg_b = $vb - $vg;
- if ( $vr > -3
- and $vr < 2
- and $vg > -3
- and $vg < 2
- and $vb > -3
- and $vb < 2) {
- $qoi_data .= chr(QOI_OP_DIFF | (($vr + 2) << 4) | (($vg + 2) << 2) | ($vb + 2));
- }
- elsif ( $vg_r > -9
- and $vg_r < 8
- and $vg > -33
- and $vg < 32
- and $vg_b > -9
- and $vg_b < 8) {
- $qoi_data .= join('', chr(QOI_OP_LUMA | ($vg + 32)), chr((($vg_r + 8) << 4) | ($vg_b + 8)));
- }
- else {
- $qoi_data .= join('', chr(QOI_OP_RGB), chr($px[0]), chr($px[1]), chr($px[2]));
- }
- }
- else {
- $qoi_data .= join('', chr(QOI_OP_RGBA), chr($px[0]), chr($px[1]), chr($px[2]), chr($px[3]));
- }
- }
- }
- @prev_px = @px;
- }
- }
- if ($run > 0) {
- $qoi_data .= chr(0b11_00_00_00 | ($run - 1));
- }
- my @footer;
- push(@footer, (0x00) x 7);
- push(@footer, 0x01);
- # Header
- print $out_fh pack('C*', @header);
- # Compressed data
- zstd(\$qoi_data, \my $zstd_data) or die "zstd failed: $ZstdError\n";
- print $out_fh pack("N", length($zstd_data));
- print $out_fh $zstd_data;
- # Footer
- print $out_fh pack('C*', @footer);
- }
- @ARGV || do {
- say STDERR "usage: $0 [input.png] [output.qzst]";
- exit(2);
- };
- my $in_file = $ARGV[0];
- my $out_file = $ARGV[1] // "$in_file.qzst";
- my $img = 'Imager'->new(file => $in_file)
- or die "Can't read image: $in_file";
- open(my $out_fh, '>:raw', $out_file)
- or die "Can't open file <<$out_file>> for writing: $!";
- qzst_encoder($img, $out_fh);
|