in reply to Re: Shameless plug and QR japh
in thread Shameless plug and QR japh

After thinking about the problem a bit, you could, in theory, use "colspan" for a simplistic run-length compression:

#!/usr/bin/env perl use strict; use warnings; use Text::QRCode; my $qr = Text::QRCode->new()->plot("YAPH"); my $pixelsize = 15; my $black = '<td width="' . $pixelsize . 'px" height="' . $pixelsize . + 'px" bgcolor="black"></td>'; my $white = '<td width="' . $pixelsize . 'px" height="' . $pixelsize . + 'px" bgcolor="white"></td>'; print '<table border="0">', "\n"; my $firstline = 1; my $saved = 0; foreach my $line (@{$qr}) { print "<tr>"; my $firstelem = 1; my $width = 0; my $color = ''; foreach my $elem (@{$line}) { if($firstline) { # First line, no compression. This sets the correct column + width for all columns if($elem eq '*') { print $black; } else { print $white; } } else { if($firstelem) { $color = $elem; $width = 1; $firstelem = 0; } else { if($color eq $elem) { $width++; $saved++; } else { my $realcol = 'white'; if($elem eq '*') { $realcol = 'black'; } print '<td colspan="' . $width . '" height="' . $p +ixelsize . 'px" bgcolor="' . $realcol . '"></td>'; $color = $elem; $width = 1; } } } if(!$firstline) { # print last element of the current line my $realcol = 'white'; if($elem eq '*') { $realcol = 'black'; } print '<td colspan="' . $width . '" height="' . $pixelsize + . 'px" bgcolor="' . $realcol . '"></td>'; } $firstline = 0; } print "</tr>\n"; } print '<\table">', "\n"; print '<!-- run length compression saved ', $saved, ' table fields-->' +, "\n";

I've run into a formatting problem doing this (probably some stupid oversight on my part), but it might be worth the effort if you need to "compress" your code to the 64K limit in PerlMonks. See What is PerlMonks post size limit?

perl -e 'use Crypt::Digest::SHA256 qw[sha256_hex]; print substr(sha256_hex("the Answer To Life, The Universe And Everything"), 6, 2), "\n";'

Replies are listed 'Best First'.
Re^3: Shameless plug and QR japh
by cavac (Prior) on Apr 08, 2022 at 13:19 UTC

    After a bit of tinkering and bugfixing, the solution is:

    #!/usr/bin/env perl use strict; use warnings; use Text::QRCode; my $qr = Text::QRCode->new()->plot("YAPH"); my $pixelsize = 15; print '<table border="0" cellspacing="0" cellpadding="0">', "\n"; my $firstline = 1; my $saved = 0; foreach my $line (@{$qr}) { print "<tr>"; my $firstelem = 1; my $width = 0; my $color = ''; my $firstblockinline = 1; foreach my $elem (@{$line}) { if($firstline) { # First line, no compression. This sets the correct column + width for all columns my $realcol = mapColor($elem); print '<td width="' . $pixelsize . 'px" height="' . $pixel +size . 'px" bgcolor="' . $realcol . '"></td>'; } else { if($firstelem) { $color = $elem; $width = 1; $firstelem = 0; } else { if($color eq $elem) { $width++; $saved++; } else { my $realcol = mapColor($color); print '<td colspan="' . $width . '" '; if($firstblockinline) { print 'height="' . $pixelsize . 'px" '; $firstblockinline = 0; } print 'bgcolor="' . $realcol . '"></td>'; $color = $elem; $width = 1; } } } } if(!$firstline) { # print last element of the current line my $realcol = mapColor($color); print '<td colspan="' . $width . '" height="' . $pixelsize . ' +px" bgcolor="' . $realcol . '"></td>'; } print "</tr>\n"; $firstline = 0; } print '</table>', "\n"; print '<!-- run length compression saved ', $saved, ' table fields-->' +, "\n"; sub mapColor { my ($inval) = @_; if($inval eq '*') { return 'black'; } return 'white'; }

    Which means i can turn it into this:

    #!/usr/bin/env perl use strict; use warnings; use GD; my $img = GD::Image->newFromPng('tentacle.png', 0); my ($w, $h) = $img->getBounds(); my $pixelsize = 15; print '<table border="0" cellspacing="0" cellpadding="0">', "\n"; my $saved = 0; for(my $y = 0; $y < $h; $y++) { print "<tr>"; my $firstelem = 1; my $width = 0; my $color = ''; my $firstblockinline = 1; for(my $x = 0; $x < $w; $x++) { my $index = $img->getPixel($x, $y); my ($r,$g,$b) = $img->rgb($index); my $elem = sprintf("#%02X%02X%02X", $r, $g, $b); if(!$y) { # First line, no compression. This sets the correct column + width for all columns print '<td width="' . $pixelsize . 'px" height="' . $pixel +size . 'px" bgcolor="' . $elem . '"></td>'; } else { if($firstelem) { $color = $elem; $width = 1; $firstelem = 0; } else { if($color eq $elem) { $width++; $saved++; } else { print '<td colspan="' . $width . '" '; if($firstblockinline) { print 'height="' . $pixelsize . 'px" '; $firstblockinline = 0; } print 'bgcolor="' . $color . '"></td>'; $color = $elem; $width = 1; } } } } if($y) { # print last element of the current line print '<td colspan="' . $width . '" height="' . $pixelsize . ' +px" bgcolor="' . $color . '"></td>'; } print "</tr>\n"; } print '</table>', "\n"; print '<!-- run length compression saved ', $saved, ' table fields-->' +, "\n";

    Which results in the ability to display (low res) colorful images in PerlMonks, using nothing but allowed HTML tags:

    <!-- run length compression saved 709 table fields-->

    perl -e 'use Crypt::Digest::SHA256 qw[sha256_hex]; print substr(sha256_hex("the Answer To Life, The Universe And Everything"), 6, 2), "\n";'