termcol: ?img option to draw one image with each palette
authorMischa POSLAWSKY <perl@shiar.org>
Mon, 2 Nov 2015 04:48:59 +0000 (05:48 +0100)
committerMischa POSLAWSKY <perl@shiar.org>
Tue, 5 Jan 2016 00:05:07 +0000 (01:05 +0100)
Manipulate source PNG file at data/indi.png to use palette colours in order
to compare look of an EGA game for each.  Quickly implemented by overwriting
data at certain positions, which will break with unexpected data.

Inline encoding increases page size by 6⋅5kB ≈ 30kB.

termcol.plp

index 0b3d2364a11ed39824afd06ca979833a12ea0f1f..04157ef95798ed3fa47d0e5f4fbd668c11a70467 100644 (file)
@@ -14,6 +14,8 @@ Html({
        stylesheet => [qw'light dark'],
 });
 
+my $imgfile = exists $get{img} && 'indi.png';
+
 my @termlist;
 push @termlist, split /\W+/, $ENV{PATH_INFO} || 'default';
 
@@ -42,6 +44,7 @@ print
 
 <div class="section">
 <:
+use 5.010;
 use Shiar_Sheet::Colour '1.03';
 use List::Util qw( min max );
 
@@ -69,6 +72,28 @@ sub colcell {
        return "$out\n";
 }
 
+sub img_egapal {
+       my ($palette) = @_;
+       return eval {
+               require MIME::Base64;
+               require Digest::CRC;
+
+               local $/;
+               open my $img, '<:bytes', "data/$imgfile" or die "$!\n";
+               my $imgdata = readline $img;
+
+               my $offset = 0x29 - 4;
+               my $len = 16 * 3;
+               my $chunklen = $len + 4;
+               substr($imgdata, $offset+4, $len) = pack 'H*', join '', @{$palette};
+               my ($p, $crc) = unpack "x${offset}a${chunklen}N", $imgdata;
+               substr($imgdata, $offset+4+$len, 4) = pack 'N', Digest::CRC::crc32($p);
+
+               return sprintf '<img src="data:image/png;base64,%s">',
+                       MIME::Base64::encode_base64($imgdata);
+       } || $@;
+}
+
 for my $term (@termlist) {
        my $info = $palettes->{$term};
        ref $info eq 'HASH' or next;
@@ -104,6 +129,8 @@ for my $term (@termlist) {
                        $name = [ $name, ['#333'] ] if $term eq 'xkcd';
                        print '<tr>', colcell($name, $rgb);
                }
+
+               print '<tr><td>', img_egapal(\@{$colours}) if $imgfile;
                print "</table>\n\n";
        }
 }
@@ -168,10 +195,17 @@ sub coltable_hsv {
                my $colbreak = scalar map { @$_ } @colmap;  # same width as hue rows
                for my $num (sort { $greymap{$a} <=> $greymap{$b} } keys %greymap) {
                        $out .= '<tr>' unless $col++ % $colbreak;
-                       $out .= colcell($num, ($greymap{$num}) x 3);
+                       $out .= colcell($num, ($greymap{$num}));
                }
        }
 
+       if ($imgfile) {
+               my @palette = map { [ @{$_}[1 .. 3] ] } map {@$_} map {@$_} @colmap;
+               my $imgdata = img_egapal(\@palette);
+               my $tablespan = scalar map { @$_ } @colmap;
+               $out .= "<tr><td colspan=$tablespan>$imgdata";
+       }
+
        return $out;
 }