first proof of concept

1 files changed, 90 insertions, 0 deletions

diff --git a/qr-color.pl b/qr-color.pl
new file mode 100644
index 0000000..dc8c825
--- /dev/null
+++ b/qr-color.pl
@@ -0,0 +1,90 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Text::QRCode;
+use Term::ANSIColor;
+
+{
+my %colours = (
+    'black' => [
+        map { color($_,'on_black') }
+            'dark yellow','dark green','dark blue'
+        ],
+    'white' => [
+        map { color($_,'on_white') }
+            'green', 'blue', 'yellow'
+        ],
+);
+
+my $strip_length = 0;
+
+sub rotate {
+    my ($arr) = @_;
+
+    my $el = shift @$arr;
+    push @$arr, $el;
+    return;
+}
+
+sub next_colour {
+    my ($which) = @_;
+
+    if ($strip_length < 1) {
+        $strip_length = 1+int(rand(7));
+        rotate($colours{$which});
+    }
+    --$strip_length;
+    return $colours{$which}->[0];
+}
+}
+
+
+sub draw_cell {
+    print next_colour(shift eq '*' ? 'black' : 'white'),
+        chr(65+int(rand(26)));
+}
+{
+my $white = color('black','on_white');
+my $reset = color('reset');
+sub draw_row {
+    my ($row,$scale)=@_;
+    $scale||=1;
+    print $white,' 'x(3*$scale);
+    for my $cell (@$row) {
+        draw_cell($cell) for 1..$scale;
+    }
+    print $white,' 'x(3*$scale);
+    print $reset,"\n";
+}
+sub draw_empty_row {
+    my ($row,$scale)=@_;
+    $scale||=1;
+
+    print $white,' 'x((6+@$row)*$scale),$reset,"\n" for 1..(3*$scale);
+}
+}
+
+sub draw_whole {
+    my ($arr,$scale)=@_;
+    $scale||=1;
+
+    draw_empty_row($arr->[0],$scale);
+
+    for my $row (@$arr) {
+        draw_row($row,$scale) for 1..$scale;
+    }
+
+    draw_empty_row($arr->[0],$scale);
+}
+
+
+my $data='MECARD:N:Ceccarelli,Gianni;TEL:+447564023056;EMAIL:dakkar@thenautilus.net;URL:http://www.thenautilus.net/contacts/;NICKNAME:dakkar;;';
+
+my $qr=Text::QRCode->new(
+    level=>'H',
+    mode=>'8-bit',
+);
+
+my $arr=$qr->plot($data);
+
+draw_whole($arr,1);