the filler works, and we have two printers

5 files changed, 141 insertions, 74 deletions

diff --git a/lib/GridFiller.pm b/lib/GridFiller.pm
index d036094..ebeb933 100644
--- a/lib/GridFiller.pm
+++ b/lib/GridFiller.pm
@@ -3,33 +3,20 @@ 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;
 
+with 'MooseX::Log::Log4perl';
+
 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 '*'
-                    } @$_
-                ]
-            } @$_
-        ]
-    };
+subtype GridT, as ArrayRef[ArrayRef[Str]];
 
 has words => (
     isa => ArrayRef[Str],
@@ -82,7 +69,7 @@ sub _build__grid_status {
             map {
                 [
                     map {
-                        $_ ? $BLACK : $WHITE
+                        $_ eq '*' ? $BLACK : $WHITE
                     } @$_
                 ]
             } @{shift->grid}
@@ -108,7 +95,7 @@ sub _build_result {
             map {
                 [
                     map {
-                        [0,' '],
+                        [ ( $_ eq '*' ? 3 : 1 ), ' ' ],
                     } @$_
                 ]
             } @{shift->grid}
@@ -132,22 +119,30 @@ sub fill {
     while ($self->_unfilled() && $self->_has_next_word()) {
         my $word = $self->_get_next_word();
 
-        my ($x,$y,$dir);
+        $self->log->debug("Placing $word");
 
-        try { ($x,$y,$dir) = $self->_find_place_for($word) }
-        catch {
+        my ($x,$y,$dir) = $self->_find_place_for($word);
+
+        if (! defined $x) {
+            $self->log->debug("No place for $word");
             $self->_mark_leftover($word);
             next;
         };
 
         $self->_place_word_at($word,$x,$y,$dir);
+
+        if ($self->log->is_debug) {
+            $self->_log_status;
+        }
     }
 }
 
 sub _place_word_at {
     my ($self, $word, $x, $y, $dir) = @_;
 
-    my $colour = $self->_find_colour_for($x,$y);
+    my $colour = $self->_find_colour_for($x,$y,$dir);
+
+    $self->log->debug("Placing $word at ${x}:${y} ($dir) in colour $colour");
 
     if ($dir == $HORIZONTAL) {
         for my $i (0..length($word)-1) {
@@ -177,6 +172,17 @@ sub _mark_occupied {
     return;
 }
 
+sub _unfilled {
+    my ($self) = @_;
+
+    for my $row (@{$self->_grid_status}) {
+        for my $cell (@$row) {
+            return 1 if $cell != 0;
+        }
+    }
+    return 0;
+}
+
 sub _put_letter_at {
     my ($self,$letter,$x,$y,$colour) = @_;
 
@@ -189,17 +195,17 @@ sub _find_colour_for {
 
     # let's be easy
     if ($dir == $HORIZONTAL) {
-        return $self->grid->[$y][$x]==$WHITE ? 1 : 3;
+        return $self->grid->[$y][$x] eq '*' ? 3 : 1;
     }
     else {
-        return $self->grid->[$y][$x]==$WHITE ? 2 : 4;
+        return $self->grid->[$y][$x] eq '*' ? 4 : 2;
     }
 }
 
 sub _find_place_for {
     my ($self,$word) = @_;
 
-    my $dir = int(rand(2)) > 1 ? $HORIZONTAL : $VERTICAL;
+    my $dir = int(rand(2)) ? $HORIZONTAL : $VERTICAL;
 
     my $length = length $word;
 
@@ -214,20 +220,18 @@ sub _find_place_for {
         @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 $rows = scalar @{$self->grid};
     my $col;
 
-    for my $row (0..$cols) {
+    for my $row (0..$rows-1) {
         $col = $self->_find_in_row($row,$length);
-        return ($row,$col,$HORIZONTAL) if defined $col;
+        return ($col,$row,$HORIZONTAL) if defined $col;
     }
     return;
 }
@@ -235,47 +239,69 @@ sub _find_place_horiz {
 sub _find_place_vert {
     my ($self,$length) = @_;
 
-    my $rows = scalar @{$self->grid};
+    my $cols = scalar @{$self->grid->[0]};
     my $row;
 
-    for my $col (0..$rows) {
+    for my $col (0..$cols-1) {
         $row = $self->_find_in_col($col,$length);
-        return ($row,$col,$VERTICAL) if defined $row;
+        return ($col,$row,$VERTICAL) if defined $row;
     }
     return;
 }
 
-sub _find_in_row {
-    my ($self,$row,$length) = @_;
+{
+my @symbols=(' ','X','O');
+
+sub _do_find {
+    my ($self,$str,$length) = @_;
 
-    my $str = join '',map { $_ ? '*' : ' ' } @{$self->_grid_status->[$row]};
+    my ($skip) = ($str =~ m{^ (.*?) (?: X{$length} | O{$length} ) }x);
 
-    my ($skip) = ($str =~ m{^ (.*?) (?: \*{$length})}x);
+    $self->log->debug(defined $skip ? " skip <$skip>" : " nope");
 
     return length($skip) if defined $skip;
     return;
 }
 
+sub _find_in_row {
+    my ($self,$row,$length) = @_;
+
+    my $str = join '',map { $symbols[$_] } @{$self->_grid_status->[$row]};
+
+    $self->log->debug("row $row = $str");
+
+    return $self->_do_find($str,$length);
+}
+
 sub _find_in_col {
     my ($self,$col,$length) = @_;
 
-    my $str = join '',map { $_->[$col] ? '*' : ' ' } @{$self->_grid_status};
+    my $str = join '',map { $symbols[$_->[$col]] } @{$self->_grid_status};
 
-    my ($skip) = ($str =~ m{^ (.*?) (?: \*{$length})}x);
+    $self->log->debug("col $col = $str");
 
-    return length($skip) if defined $skip;
-    return;
+    return $self->_do_find($str,$length);
 }
 
-sub _unfilled {
+sub _log_status {
     my ($self) = @_;
 
-    for my $row (@{$self->_grid_status}) {
-        for my $cell (@$row) {
-            return 1 if $cell != 0;
+    my $str = "\n";
+
+    my $rows = scalar @{$self->grid};
+
+    for my $row (0..$rows-1) {
+        for my $cell (@{$self->_grid_status->[$row]}) {
+            $str .= $symbols[$cell];
         }
+        $str .= '    ';
+        for my $cell (@{$self->result->[$row]}) {
+            $str .= $cell->[1] eq ' ' ? '.' : $cell->[1];
+        }
+        $str .= "\n";
     }
-    return 0;
+    $self->log->debug($str);
+}
 }
 
 1;
diff --git a/lib/TextPrinter.pm b/lib/TextPrinter.pm
index 7ef8572..1715959 100644
--- a/lib/TextPrinter.pm
+++ b/lib/TextPrinter.pm
@@ -1,42 +1,29 @@
 package TextPrinter;
-use strict;
-use warnings;
+use Moose;
+use namespace::autoclean;
 use Term::ANSIColor;
 
-my @colours = (
-    color('reset'), # filler
-    (
-        map { color($_,'on_white') }
-            'blue', 'green',
-    ),
-    (
-        map { color($_,'on_black') }
-            'dark yellow','dark green',
-    ),
-);
-
 sub draw_cell {
-    my ($cell) = @_;
+    my ($self,$cell) = @_;
 
-    print $colours[$cell->[0]],
-        $cell->[1];
+    die "unimplemented";
 }
 
 {
 my $white = color('black','on_white');
 my $reset = color('reset');
 sub draw_row {
-    my ($row,$scale)=@_;
+    my ($self,$row,$scale)=@_;
     $scale||=1;
     print $white,' 'x(3*$scale);
     for my $cell (@$row) {
-        draw_cell($cell) for 1..$scale;
+        $self->draw_cell($cell) for 1..$scale;
     }
     print $white,' 'x(3*$scale);
     print $reset,"\n";
 }
 sub draw_empty_row {
-    my ($row,$scale)=@_;
+    my ($self,$row,$scale)=@_;
     $scale||=1;
 
     print $white,' 'x((6+@$row)*$scale),$reset,"\n" for 1..(3*$scale);
@@ -44,16 +31,16 @@ sub draw_empty_row {
 }
 
 sub draw_whole {
-    my ($arr,$scale)=@_;
+    my ($self,$arr,$scale)=@_;
     $scale||=1;
 
-    draw_empty_row($arr->[0],$scale);
+    $self->draw_empty_row($arr->[0],$scale);
 
     for my $row (@$arr) {
-        draw_row($row,$scale) for 1..$scale;
+        $self->draw_row($row,$scale) for 1..$scale;
     }
 
-    draw_empty_row($arr->[0],$scale);
+    $self->draw_empty_row($arr->[0],$scale);
 }
 
 1;
diff --git a/lib/TextPrinter/ColourGrid.pm b/lib/TextPrinter/ColourGrid.pm
new file mode 100644
index 0000000..fdb9949
--- /dev/null
+++ b/lib/TextPrinter/ColourGrid.pm
@@ -0,0 +1,27 @@
+package TextPrinter::ColourGrid;
+use Moose;
+use namespace::autoclean;
+use Term::ANSIColor;
+
+extends 'TextPrinter';
+
+my @colours = (
+    color('reset'), # filler
+    (
+        map { color($_,'on_white') }
+            'blue', 'green',
+    ),
+    (
+        map { color($_,'on_black') }
+            'dark yellow','dark green',
+    ),
+);
+
+sub draw_cell {
+    my ($self,$cell) = @_;
+
+    print $colours[$cell->[0]],
+        $cell->[1];
+}
+
+1;
diff --git a/lib/TextPrinter/StarGrid.pm b/lib/TextPrinter/StarGrid.pm
new file mode 100644
index 0000000..012cf07
--- /dev/null
+++ b/lib/TextPrinter/StarGrid.pm
@@ -0,0 +1,19 @@
+package TextPrinter::StarGrid;
+use Moose;
+use namespace::autoclean;
+use Term::ANSIColor;
+
+extends 'TextPrinter';
+
+my %colours = (
+    '*' => color('white','on_black'),
+    ' ' => color('black','on_white'),
+);
+
+sub draw_cell {
+    my ($self,$cell) = @_;
+
+    print $colours{$cell},' ';
+}
+
+1;
diff --git a/script/qr-color.pl b/script/qr-color.pl
index 45c47ee..0f779a9 100644
--- a/script/qr-color.pl
+++ b/script/qr-color.pl
@@ -2,24 +2,32 @@
 use strict;
 use warnings;
 use Text::QRCode;
-use TextPrinter;
+use TextPrinter::ColourGrid;
+use TextPrinter::StarGrid;
 use GridFiller;
 use Path::Class;
+use Log::Log4perl qw(:easy);
+Log::Log4perl->easy_init($INFO);
 
 my $data='MECARD:N:Ceccarelli,Gianni;TEL:+447564023056;EMAIL:dakkar@thenautilus.net;URL:http://www.thenautilus.net/contacts/;NICKNAME:dakkar;;';
+$data = 'x';
 
 my $qr=Text::QRCode->new(
-    level=>'H',
+    level=>'L',
     mode=>'8-bit',
 );
 
 my $arr=$qr->plot($data);
 
 my @words = grep { length($_) > 2 }
-    file('/usr/share/dict/words')->slurp(chomp=>1);
+    file('/usr/share/dict/propernames')->slurp(chomp=>1);
 
 my $filler=GridFiller->new({words=>\@words,grid=>$arr});
 
 $filler->fill;
 
-TextPrinter::draw_whole($filler->result,1);
+TextPrinter::ColourGrid->new->draw_whole($filler->result,1);
+
+print "\n\n";
+
+TextPrinter::StarGrid->new->draw_whole($arr,1);