#!/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="' . $pixelsize . '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";