1 files changed, 198 insertions, 0 deletions
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;