filler!

3 files changed, 304 insertions, 34 deletions

diff --git a/lib/GridFiller.pm b/lib/GridFiller.pm
new file mode 100644
index 0000000..d036094
--- /dev/null
+++ b/lib/GridFiller.pm
@@ -0,0 +1,281 @@
+package GridFiller;
+use Moose;
+use namespace::autoclean;
+use List::Util qw(shuffle);
+use List::MoreUtils qw(uniq);
+use TryCatch;
+use MooseX::Types -declare => [qw( GridT Char LetterCell )];
+use MooseX::Types::Moose qw(Str ArrayRef Bool Int);
+use MooseX::Types::Structured qw(Tuple);
+use Carp;
+
+my $VERTICAL = 1;
+my $HORIZONTAL = 2;
+
+my $BLACK = 1;
+my $WHITE = 2;
+
+subtype GridT, as ArrayRef[ArrayRef[Bool]];
+
+coerce GridT,
+    from ArrayRef[ArrayRef[Str]],
+    via {
+        [
+            map {
+                [
+                    map {
+                        $_ eq '*'
+                    } @$_
+                ]
+            } @$_
+        ]
+    };
+
+has words => (
+    isa => ArrayRef[Str],
+    required => 1,
+    is => 'ro',
+);
+
+has grid => (
+    isa => GridT,
+    required => 1,
+    is => 'ro',
+);
+
+has _words_to_use => (
+    isa => ArrayRef[Str],
+    traits => ['Array'],
+    handles => {
+        _has_next_word => 'count',
+        _get_next_word => 'shift',
+    },
+    is => 'rw',
+    lazy_build => 1,
+    clearer => '_reset_words_to_use',
+);
+
+sub _build__words_to_use {
+    # clone initial word list
+    return [ shuffle uniq @{shift->words} ];
+}
+
+has leftover_words => (
+    isa => ArrayRef[Str],
+    is => 'ro',
+    traits => ['Array'],
+    handles => {
+        _mark_leftover => 'push',
+    },
+    clearer => '_reset_leftovers',
+);
+
+has _grid_status => (
+    isa => ArrayRef[ArrayRef[Int]],
+    is => 'rw',
+    lazy_build => 1,
+    clearer => '_reset_grid_status',
+);
+
+sub _build__grid_status {
+    return [
+            map {
+                [
+                    map {
+                        $_ ? $BLACK : $WHITE
+                    } @$_
+                ]
+            } @{shift->grid}
+    ];
+}
+
+subtype Char,
+    as Str,
+    where { length($_) == 1 };
+
+subtype LetterCell,
+    as Tuple[Int,Char];
+
+has result => (
+    isa => ArrayRef[ArrayRef[LetterCell]],
+    is => 'ro',
+    lazy_build => 1,
+    clearer => '_reset_result',
+);
+
+sub _build_result {
+    return [
+            map {
+                [
+                    map {
+                        [0,' '],
+                    } @$_
+                ]
+            } @{shift->grid}
+    ];
+}
+
+sub _reset {
+    my ($self) = @_;
+
+    $self->_reset_words_to_use();
+    $self->_reset_grid_status();
+    $self->_reset_leftovers();
+    $self->_reset_result();
+}
+
+sub fill {
+    my ($self) = @_;
+
+    $self->_reset();
+
+    while ($self->_unfilled() && $self->_has_next_word()) {
+        my $word = $self->_get_next_word();
+
+        my ($x,$y,$dir);
+
+        try { ($x,$y,$dir) = $self->_find_place_for($word) }
+        catch {
+            $self->_mark_leftover($word);
+            next;
+        };
+
+        $self->_place_word_at($word,$x,$y,$dir);
+    }
+}
+
+sub _place_word_at {
+    my ($self, $word, $x, $y, $dir) = @_;
+
+    my $colour = $self->_find_colour_for($x,$y);
+
+    if ($dir == $HORIZONTAL) {
+        for my $i (0..length($word)-1) {
+            $self->_mark_occupied($x+$i,$y);
+            $self->_put_letter_at(substr($word,$i,1),
+                                  $x+$i,$y,
+                                  $colour);
+        }
+    }
+    elsif ($dir == $VERTICAL) {
+        for my $i (0..length($word)-1) {
+            $self->_mark_occupied($x,$y+$i);
+            $self->_put_letter_at(substr($word,$i,1),
+                                  $x,$y+$i,
+                                  $colour);
+        }
+    }
+    else {
+        croak "What dir $dir?";
+    }
+}
+
+sub _mark_occupied {
+    my ($self,$x,$y) = @_;
+
+    $self->_grid_status->[$y][$x]=0;
+    return;
+}
+
+sub _put_letter_at {
+    my ($self,$letter,$x,$y,$colour) = @_;
+
+    $self->result()->[$y][$x]=[$colour,$letter];
+    return;
+}
+
+sub _find_colour_for {
+    my ($self,$x,$y,$dir) = @_;
+
+    # let's be easy
+    if ($dir == $HORIZONTAL) {
+        return $self->grid->[$y][$x]==$WHITE ? 1 : 3;
+    }
+    else {
+        return $self->grid->[$y][$x]==$WHITE ? 2 : 4;
+    }
+}
+
+sub _find_place_for {
+    my ($self,$word) = @_;
+
+    my $dir = int(rand(2)) > 1 ? $HORIZONTAL : $VERTICAL;
+
+    my $length = length $word;
+
+    my @ret;
+
+    if ($dir == $HORIZONTAL) {
+        @ret = $self->_find_place_horiz($length);
+        @ret = $self->_find_place_vert($length) unless @ret;
+    }
+    else {
+        @ret = $self->_find_place_vert($length);
+        @ret = $self->_find_place_horiz($length) unless @ret;
+    }
+
+    die "No place for $word" unless @ret;
+
+    return @ret;
+}
+
+sub _find_place_horiz {
+    my ($self,$length) = @_;
+
+    my $cols = scalar @{$self->grid->[0]};
+    my $col;
+
+    for my $row (0..$cols) {
+        $col = $self->_find_in_row($row,$length);
+        return ($row,$col,$HORIZONTAL) if defined $col;
+    }
+    return;
+}
+
+sub _find_place_vert {
+    my ($self,$length) = @_;
+
+    my $rows = scalar @{$self->grid};
+    my $row;
+
+    for my $col (0..$rows) {
+        $row = $self->_find_in_col($col,$length);
+        return ($row,$col,$VERTICAL) if defined $row;
+    }
+    return;
+}
+
+sub _find_in_row {
+    my ($self,$row,$length) = @_;
+
+    my $str = join '',map { $_ ? '*' : ' ' } @{$self->_grid_status->[$row]};
+
+    my ($skip) = ($str =~ m{^ (.*?) (?: \*{$length})}x);
+
+    return length($skip) if defined $skip;
+    return;
+}
+
+sub _find_in_col {
+    my ($self,$col,$length) = @_;
+
+    my $str = join '',map { $_->[$col] ? '*' : ' ' } @{$self->_grid_status};
+
+    my ($skip) = ($str =~ m{^ (.*?) (?: \*{$length})}x);
+
+    return length($skip) if defined $skip;
+    return;
+}
+
+sub _unfilled {
+    my ($self) = @_;
+
+    for my $row (@{$self->_grid_status}) {
+        for my $cell (@$row) {
+            return 1 if $cell != 0;
+        }
+    }
+    return 0;
+}
+
+1;
diff --git a/lib/TextPrinter.pm b/lib/TextPrinter.pm
index d786b86..7ef8572 100644
--- a/lib/TextPrinter.pm
+++ b/lib/TextPrinter.pm
@@ -3,45 +3,25 @@ use strict;
 use warnings;
 use Term::ANSIColor;
 
-{
-my %colours = (
-    'black' => [
-        map { color($_,'on_black') }
-            'dark yellow','dark green','dark blue'
-        ],
-    'white' => [
+my @colours = (
+    color('reset'), # filler
+    (
         map { color($_,'on_white') }
-            'green', 'blue', 'yellow'
-        ],
+            'blue', 'green',
+    ),
+    (
+        map { color($_,'on_black') }
+            'dark yellow','dark green',
+    ),
 );
 
-my $strip_length = 0;
-
-sub rotate {
-    my ($arr) = @_;
-
-    my $el = shift @$arr;
-    push @$arr, $el;
-    return;
-}
-
-sub next_colour {
-    my ($which) = @_;
+sub draw_cell {
+    my ($cell) = @_;
 
-    if ($strip_length < 1) {
-        $strip_length = 1+int(rand(7));
-        rotate($colours{$which});
-    }
-    --$strip_length;
-    return $colours{$which}->[0];
-}
+    print $colours[$cell->[0]],
+        $cell->[1];
 }
 
-
-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');
diff --git a/script/qr-color.pl b/script/qr-color.pl
index ecf7025..45c47ee 100644
--- a/script/qr-color.pl
+++ b/script/qr-color.pl
@@ -3,6 +3,8 @@ use strict;
 use warnings;
 use Text::QRCode;
 use TextPrinter;
+use GridFiller;
+use Path::Class;
 
 my $data='MECARD:N:Ceccarelli,Gianni;TEL:+447564023056;EMAIL:dakkar@thenautilus.net;URL:http://www.thenautilus.net/contacts/;NICKNAME:dakkar;;';
 
@@ -13,4 +15,11 @@ my $qr=Text::QRCode->new(
 
 my $arr=$qr->plot($data);
 
-TextPrinter::draw_whole($arr,1);
+my @words = grep { length($_) > 2 }
+    file('/usr/share/dict/words')->slurp(chomp=>1);
+
+my $filler=GridFiller->new({words=>\@words,grid=>$arr});
+
+$filler->fill;
+
+TextPrinter::draw_whole($filler->result,1);