Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Re^3: Shameless plug and QR japh

by cavac (Priest)
on Apr 08, 2022 at 13:19 UTC ( #11142834=note: print w/replies, xml ) Need Help??


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

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";'

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11142834]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (3)
As of 2022-06-24 22:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My most frequent journeys are powered by:









    Results (80 votes). Check out past polls.

    Notices?