big refactoring

6 files changed, 416 insertions, 301 deletions

diff --git a/lib/GridFiller.pm b/lib/GridFiller.pm
index 38bf7f6..44f0a50 100644
--- a/lib/GridFiller.pm
+++ b/lib/GridFiller.pm
@@ -1,25 +1,15 @@
 package GridFiller;
 use Moose;
 use namespace::autoclean;
-use List::Util qw(shuffle);
-use List::MoreUtils qw(uniq);
-use MooseX::Types -declare => [qw( GridT Char LetterCell )];
-use MooseX::Types::Moose qw(Str ArrayRef Bool Int);
-use MooseX::Types::Structured qw(Tuple);
+use GridFiller::Types qw(GridT WordListT);
+use GridFiller::Status;
+use GridFiller::Result;
 use Carp;
 
 with 'MooseX::Log::Log4perl';
 
-my $VERTICAL = 1;
-my $HORIZONTAL = 2;
-
-my $BLACK = 1;
-my $WHITE = 2;
-
-subtype GridT, as ArrayRef[ArrayRef[Str]];
-
 has words => (
-    isa => ArrayRef[Str],
+    isa => WordListT,
     required => 1,
     is => 'ro',
 );
@@ -30,308 +20,35 @@ has grid => (
     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 {
-                        $_ eq '*' ? $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 _reset {
-    my ($self) = @_;
-
-    $self->_reset_words_to_use();
-    $self->_reset_grid_status();
-    $self->_reset_leftovers();
-    $self->_reset_result();
-}
-
 sub fill {
     my ($self) = @_;
 
-    $self->_reset();
+    my $status = GridFiller::Status->new({grid => $self->grid, words => $self->words});
+    my $result = GridFiller::Result->new({source_grid => $self->grid});
 
-    while ($self->_unfilled() && $self->_has_next_word()) {
-        my $word = $self->_get_next_word();
+    while ($status->unfilled() && $status->has_next_word()) {
+        my $word = $status->get_next_word();
 
         $self->log->debug("Placing $word");
 
-        my ($x,$y,$dir) = $self->_find_place_for($word);
+        my ($x,$y,$dir) = $status->find_place_for($word);
 
         if (! defined $x) {
             $self->log->debug("No place for $word");
-            $self->_mark_leftover($word);
+            $result->mark_leftover($word);
             next;
         };
 
-        $self->_place_word_at($word,$x,$y,$dir);
+        $result->place_word_at($word,$x,$y,$dir);
+        $status->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,$dir);
-
-    $self->log->debug("Placing $word at ${x}:${y} ($dir) in colour $colour");
-
-    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);
+            $self->log->debug($status->to_string);
+            $self->log->debug($result->to_string);
         }
     }
-    else {
-        croak "What dir $dir?";
-    }
-}
-
-sub _mark_occupied {
-    my ($self,$x,$y) = @_;
-
-    $self->_grid_status->[$y][$x]=0;
-    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) = @_;
-
-    $self->result()->[$y][$x]=[$colour,$letter];
-    return;
-}
-
-{
-my %colourmap = (
-    '*' => {
-        $HORIZONTAL => {
-            0 => 1,
-            1 => 2,
-        },
-        $VERTICAL => {
-            0 => 3,
-            1 => 4,
-        },
-    },
-    ' ' => {
-        $HORIZONTAL => {
-            0 => 5,
-            1 => 6,
-        },
-        $VERTICAL => {
-            0 => 7,
-            1 => 8,
-        },
-    },
-);
-
-sub _build_result {
-    return [
-            map {
-                [
-                    map {
-                        [ $colourmap{$_}->{$HORIZONTAL}->{0}, ' ' ],
-                    } @$_
-                ]
-            } @{shift->grid}
-    ];
-}
-
-sub _find_colour_for {
-    my ($self,$x,$y,$dir) = @_;
-
-    my $parity = ($dir == $HORIZONTAL) ? ($y % 2) : ($x % 2);
-
-    my $chosen = $colourmap{$self->grid->[$y][$x]}->{$dir}->{$parity};
-
-    # avoid colour runs
-    if ( ( $x>0 && $dir == $HORIZONTAL && $self->result->[$y][$x-1][0] == $chosen )
-             or
-         ( $y>0 && $dir == $VERTICAL && $self->result->[$y-1][$x][0] == $chosen )
-     ) {
-        $chosen = $colourmap{$self->grid->[$y][$x]}->{$dir}->{1-$parity};
-    }
-    return $chosen;
-}
-}
-
-sub _find_place_for {
-    my ($self,$word) = @_;
-
-    my $dir = int(rand(2)) ? $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;
-    }
-
-    return @ret;
-}
-
-sub _find_place_horiz {
-    my ($self,$length) = @_;
-
-    my $rows = scalar @{$self->grid};
-    my $col;
-
-    for my $row (0..$rows-1) {
-        $col = $self->_find_in_row($row,$length);
-        return ($col,$row,$HORIZONTAL) if defined $col;
-    }
-    return;
-}
-
-sub _find_place_vert {
-    my ($self,$length) = @_;
-
-    my $cols = scalar @{$self->grid->[0]};
-    my $row;
-
-    for my $col (0..$cols-1) {
-        $row = $self->_find_in_col($col,$length);
-        return ($col,$row,$VERTICAL) if defined $row;
-    }
-    return;
-}
-
-{
-my @symbols=(' ','X','O');
-
-sub _do_find {
-    my ($self,$str,$length) = @_;
-
-    my ($skip) = ($str =~ m{^ (.*?) (?: X{$length} | O{$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 { $symbols[$_->[$col]] } @{$self->_grid_status};
-
-    $self->log->debug("col $col = $str");
-
-    return $self->_do_find($str,$length);
-}
-
-sub _log_status {
-    my ($self) = @_;
-
-    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";
-    }
-    $self->log->debug($str);
-}
+    return $result;
 }
 
 1;
diff --git a/lib/GridFiller/Constants.pm b/lib/GridFiller/Constants.pm
new file mode 100644
index 0000000..d707782
--- /dev/null
+++ b/lib/GridFiller/Constants.pm
@@ -0,0 +1,30 @@
+package GridFiller::Constants;
+use strict;
+use warnings;
+use Scalar::Readonly qw(readonly_on);
+use namespace::autoclean;
+require Exporter;
+
+our @ISA='Exporter';
+our @EXPORT=();
+our @EXPORT_OK=qw($HORIZONTAL $VERTICAL $BLACK $WHITE $NOTHING);
+our %EXPORT_TAGS=(
+    colours => [qw($BLACK $WHITE $NOTHING)],
+    directions => [qw($HORIZONTAL $VERTICAL)],
+    all => [@EXPORT_OK],
+);
+
+our $VERTICAL = 1;
+our $HORIZONTAL = 2;
+
+our $NOTHING = 0;
+our $BLACK = 1;
+our $WHITE = 2;
+
+readonly_on($VERTICAL);
+readonly_on($HORIZONTAL);
+readonly_on($NOTHING);
+readonly_on($BLACK);
+readonly_on($WHITE);
+
+1;
diff --git a/lib/GridFiller/Result.pm b/lib/GridFiller/Result.pm
new file mode 100644
index 0000000..56ae3c2
--- /dev/null
+++ b/lib/GridFiller/Result.pm
@@ -0,0 +1,144 @@
+package GridFiller::Result;
+use Moose;
+use namespace::autoclean;
+use GridFiller::Types qw(GridT ResultT WordListT);
+use GridFiller::Constants ':directions';
+use Carp;
+
+with 'MooseX::Log::Log4perl';
+
+has leftover_words => (
+    isa => WordListT,
+    is => 'ro',
+    default => sub { [ ] },
+    traits => ['Array'],
+    handles => {
+        mark_leftover => 'push',
+    },
+);
+
+has grid => (
+    isa => ResultT,
+    is => 'ro',
+    lazy_build => 1,
+);
+
+has source_grid => (
+    isa => GridT,
+    is => 'ro',
+);
+
+{
+my %colourmap = (
+    '*' => {
+        $HORIZONTAL => {
+            0 => 1,
+            1 => 2,
+        },
+        $VERTICAL => {
+            0 => 3,
+            1 => 4,
+        },
+    },
+    ' ' => {
+        $HORIZONTAL => {
+            0 => 5,
+            1 => 6,
+        },
+        $VERTICAL => {
+            0 => 7,
+            1 => 8,
+        },
+    },
+);
+
+sub _build_grid {
+    return [
+            map {
+                [
+                    map {
+                        [ $colourmap{$_}->{$HORIZONTAL}->{0}, ' ' ],
+                    } @$_
+                ]
+            } @{shift->source_grid}
+    ];
+}
+
+sub _find_colour_for {
+    my ($self,$x,$y,$dir) = @_;
+
+    my $parity = ($dir == $HORIZONTAL) ? ($y % 2) : ($x % 2);
+
+    my $chosen = $colourmap{$self->source_grid->[$y][$x]}->{$dir}->{$parity};
+
+    # avoid colour runs
+    if ( ( $x>0 && $dir == $HORIZONTAL && $self->grid->[$y][$x-1][0] == $chosen )
+             or
+         ( $y>0 && $dir == $VERTICAL && $self->grid->[$y-1][$x][0] == $chosen )
+     ) {
+        $chosen = $colourmap{$self->source_grid->[$y][$x]}->{$dir}->{1-$parity};
+    }
+
+    if (!defined $chosen) {
+        $self->log->warn(sprintf(q{Can't decide on colour for %d:%d (%s) direction %d},
+                                 $x,$y,$self->source_grid->[$y][$x],$dir));
+    }
+
+    return $chosen;
+}
+}
+
+sub place_word_at {
+    my ($self, $word, $x, $y, $dir) = @_;
+
+    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) {
+            $self->_put_letter_at(substr($word,$i,1),
+                                  $x+$i,$y,
+                                  $colour);
+        }
+    }
+    elsif ($dir == $VERTICAL) {
+        for my $i (0..length($word)-1) {
+            $self->_put_letter_at(substr($word,$i,1),
+                                  $x,$y+$i,
+                                  $colour);
+        }
+    }
+    else {
+        croak "What dir $dir?";
+    }
+}
+
+sub _put_letter_at {
+    my ($self,$letter,$x,$y,$colour) = @_;
+
+    croak "undef colour" unless defined $colour;
+    croak "undef letter" unless defined $letter;
+
+    $self->grid->[$y][$x]=[$colour,$letter];
+    return;
+}
+
+sub to_string {
+    my ($self) = @_;
+
+    my $rows = scalar @{$self->grid};
+
+    my $str;
+
+    for my $row (0..$rows-1) {
+        for my $cell (@{$self->grid->[$row]}) {
+            $str .= $cell->[1] eq ' ' ? '.' : $cell->[1];
+        }
+        $str .= "\n";
+    }
+
+    return $str;
+}
+
+1;
diff --git a/lib/GridFiller/Status.pm b/lib/GridFiller/Status.pm
new file mode 100644
index 0000000..873d252
--- /dev/null
+++ b/lib/GridFiller/Status.pm
@@ -0,0 +1,198 @@
+package GridFiller::Status;
+use Moose;
+use namespace::autoclean;
+use List::Util qw(shuffle);
+use List::MoreUtils qw(uniq);
+use GridFiller::Types qw(WordListT GridStatusT);
+use GridFiller::Constants ':all';
+use Carp;
+
+with 'MooseX::Log::Log4perl';
+
+has words_to_use => (
+    isa => WordListT,
+    traits => ['Array'],
+    handles => {
+        has_next_word => 'count',
+        get_next_word => 'shift',
+    },
+    is => 'rw',
+);
+
+has grid_status => (
+    isa => GridStatusT,
+    is => 'rw',
+);
+
+around BUILDARGS => sub {
+    my ($orig, $class, $args, @rest) = @_;
+
+    if (exists $args->{words} && exists $args->{grid}) {
+        $args->{words_to_use} = _munge_words_to_use(delete $args->{words});
+        $args->{grid_status} = _munge_grid_status(delete $args->{grid});
+    }
+
+    return $class->$orig($args,@rest);
+};
+
+sub _munge_words_to_use {
+    my $words=shift;
+    # clone initial word list
+    return [ shuffle uniq @$words ];
+}
+
+sub _munge_grid_status {
+    my $grid=shift;
+    return [
+            map {
+                [
+                    map {
+                        $_ eq '*' ? $BLACK : $WHITE
+                    } @$_
+                ]
+            } @$grid
+    ];
+}
+
+sub place_word_at {
+    my ($self, $word, $x, $y, $dir) = @_;
+
+    $self->log->debug("Marking <$word> occupied at ${x}:${y} ($dir)");
+
+    if ($dir == $HORIZONTAL) {
+        for my $i (0..length($word)-1) {
+            $self->_mark_occupied($x+$i,$y);
+        }
+    }
+    elsif ($dir == $VERTICAL) {
+        for my $i (0..length($word)-1) {
+            $self->_mark_occupied($x,$y+$i);
+        }
+    }
+    else {
+        croak "What dir $dir?";
+    }
+}
+
+sub _mark_occupied {
+    my ($self,$x,$y) = @_;
+
+    $self->grid_status->[$y][$x]=$NOTHING;
+    return;
+}
+
+sub unfilled {
+    my ($self) = @_;
+
+    for my $row (@{$self->grid_status}) {
+        for my $cell (@$row) {
+            return 1 if $cell != $NOTHING;
+        }
+    }
+    return 0;
+}
+
+sub find_place_for {
+    my ($self,$word) = @_;
+
+    my $dir = int(rand(2)) ? $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;
+    }
+
+    return @ret;
+}
+
+sub _find_place_horiz {
+    my ($self,$length) = @_;
+
+    my $rows = scalar @{$self->grid_status};
+    my $col;
+
+    for my $row (0..$rows-1) {
+        $col = $self->_find_in_row($row,$length);
+        return ($col,$row,$HORIZONTAL) if defined $col;
+    }
+    return;
+}
+
+sub _find_place_vert {
+    my ($self,$length) = @_;
+
+    my $cols = scalar @{$self->grid_status->[0]};
+    my $row;
+
+    for my $col (0..$cols-1) {
+        $row = $self->_find_in_col($col,$length);
+        return ($col,$row,$VERTICAL) if defined $row;
+    }
+    return;
+}
+
+{
+my %symbols=(
+    $NOTHING => ' ',
+    $BLACK => 'X',
+    $WHITE => 'O',
+);
+
+sub _do_find {
+    my ($self,$str,$length) = @_;
+
+    my ($skip) = ($str =~ m{^ (.*?) (?: X{$length} | O{$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 { $symbols{$_->[$col]} } @{$self->grid_status};
+
+    $self->log->debug("col $col = $str");
+
+    return $self->_do_find($str,$length);
+}
+
+sub to_string {
+    my ($self) = @_;
+
+    my $rows = scalar @{$self->grid_status};
+
+    my $str;
+
+    for my $row (0..$rows-1) {
+        for my $cell (@{$self->grid_status->[$row]}) {
+            $str .= $symbols{$cell};
+        }
+        $str .= "\n";
+    }
+
+    return $str;
+}
+}
+
+1;
diff --git a/lib/GridFiller/Types.pm b/lib/GridFiller/Types.pm
new file mode 100644
index 0000000..fb7fc9b
--- /dev/null
+++ b/lib/GridFiller/Types.pm
@@ -0,0 +1,26 @@
+package GridFiller::Types;
+use MooseX::Types -declare =>
+    [qw(
+           GridT GridStatusT
+           CharT LetterCellT ResultT
+           WordListT
+   )];
+use MooseX::Types::Moose qw(Str ArrayRef Bool Int);
+use MooseX::Types::Structured qw(Tuple);
+
+subtype CharT,
+    as Str,
+    where { length($_) == 1 };
+
+subtype LetterCellT,
+    as Tuple[Int,CharT];
+
+subtype GridT, as ArrayRef[ArrayRef[Str]];
+
+subtype GridStatusT, as ArrayRef[ArrayRef[Int]];
+
+subtype WordListT, as ArrayRef[Str];
+
+subtype ResultT, as ArrayRef[ArrayRef[LetterCellT]];
+
+1;
diff --git a/script/qr-color.pl b/script/qr-color.pl
index 35f22dd..8d78a2f 100644
--- a/script/qr-color.pl
+++ b/script/qr-color.pl
@@ -7,7 +7,7 @@ use TextPrinter::StarGrid;
 use GridFiller;
 use Path::Class;
 use Log::Log4perl qw(:easy);
-Log::Log4perl->easy_init($INFO);
+Log::Log4perl->easy_init($DEBUG);
 
 my $data='MECARD:N:Ceccarelli,Gianni;TEL:+447564023056;EMAIL:dakkar@thenautilus.net;URL:http://www.thenautilus.net/contacts/;NICKNAME:dakkar;;';
 
@@ -23,9 +23,9 @@ my @words = grep { length($_) > 2 }
 
 my $filler=GridFiller->new({words=>\@words,grid=>$arr});
 
-$filler->fill;
+my $result = $filler->fill;
 
-TextPrinter::ColourGrid->new->draw_whole($filler->result,1);
+TextPrinter::ColourGrid->new->draw_whole($result->grid,1);
 
 print "\n\n";