Re: Shameless plug and QR japh

It took me quite a bit to get the labyrinth on my homenode cavac sort of working. And it only displays correctly on Google Chrome (using Ubuntu 20.04 here, might look different on other operating systems with different fonts installed. And i am using pre tags, not code tags.

One way to render it better on PerlMonks would be to use a HTML table with colored cells. Something like this:

<table border="0" cellspacing="0" cellpadding="0">
<tr>
<td width="20px" height="20px" bgcolor="white"></td><td width="20px" h
+eight="20px" bgcolor="black"></td><td width="20px" height="20px" bgco
+lor="white"></td><td width="20px" height="20px" bgcolor="black"></td>
</tr><tr>
<td width="20px" height="20px" bgcolor="black"></td><td width="20px" h
+eight="20px" bgcolor="white"></td><td width="20px" height="20px" bgco
+lor="black"></td><td width="20px" height="20px" bgcolor="white"></td>
</tr>
</table>
[download]

Which will give you:

So, to generate a (mostly) PM compatible version, you would do something like this:

#!/usr/bin/env perl

use strict;
use warnings;

use Text::QRCode;

my $qr = Text::QRCode->new()->plot("YAPH");

my $black = '<td width="15px" height="15px" bgcolor="black"></td>';
my $white = '<td width="15px" height="15px" bgcolor="white"></td>';
print "<p>&nbsp;</p>;\n"; # Add "silent zone"
print '<table border="0" border="0" cellspacing="0" cellpadding="0">',
+ "\n";
foreach my $line (@{$qr}) {
    print "<tr>";
    foreach my $elem (@{$line}) {
        if($elem eq '*') {
            print $black;
        } else {
            print $white;
        }
    }
    print "</tr>\n";
}   
print '<\table">', "\n";
print "<p>&nbsp;</p>;\n"; # Add "silent zone"
[download]

Resulting in a somewhat useable QR code:

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

Comment on Re: Shameless plug and QR japh Select or Download Code

Replies are listed 'Best First'.

Re^2: Shameless plug and QR japh
by ambrus (Abbot) on Apr 08, 2022 at 13:04 UTC

For a more compact representation on PerlMonks, I suggest cp437 block characters in a pre tag, two squares of the QR code encoded in each.



  ▄▄▄▄▄▄▄   ▄ ▄ ▄▄▄▄▄▄▄  
  █ ▄▄▄ █ ▄ ▄ ▀ █ ▄▄▄ █  
  █ ███ █  ▄ ▄█ █ ███ █  
  █▄▄▄▄▄█ ▄▀█▀▄ █▄▄▄▄▄█  
  ▄▄▄ ▄▄▄▄█ █ ▄▄▄   ▄    
  ▄ ▄█ ▀▄▄▄ ▀█ █▄█ █▄█▄  
   ▄▀▄█▀▄▀█▀ █▀█▄█▀▄▄    
  ▄▄▄▄▄▄▄ ██  ▄ ▀ ▄▀▄▄▄  
  █ ▄▄▄ █ █▄█ ▄ █ ▄ ▄█▄  
  █ ███ █ ▄▄ █ █▄█ ▀█▀▄  
  █▄▄▄▄▄█ ██▄█▀█▄█▀▀▄█▄

[reply]

Re^3: Shameless plug and QR japh

by hippo (Archbishop) on Apr 08, 2022 at 13:35 UTC

FWIW my QRDroid was able to read your code, ambrus, but not the one in the parent post.

🦛

[reply]

Re^4: Shameless plug and QR japh

by choroba (Cardinal) on Apr 08, 2022 at 20:21 UTC

map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]

[reply]
[d/l]

Re^5: Shameless plug and QR japh

by jdporter (Paladin) on Oct 20, 2023 at 13:18 UTC

Re^2: Shameless plug and QR japh
by cavac (Prior) on Apr 08, 2022 at 12:04 UTC

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";
[download]

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

[reply]
[d/l]
[select]

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';
}
[download]

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";
[download]

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

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

[reply]
[d/l]
[select]