package GridFiller::Status;
use Moose;
use namespace::autoclean;
use List::Util qw(shuffle);
use List::MoreUtils qw(uniq);
use GridFiller::Types qw(WordListT GridStatusT GridT WordListT);
use MooseX::Types::Moose qw(Str CodeRef);
use GridFiller::Constants ':all';
use Carp;
use feature 'switch';
with 'MooseX::Log::Log4perl';
has words => (
isa => WordListT,
required => 1,
is => 'ro',
);
has grid => (
isa => GridT,
required => 1,
is => 'ro',
);
has mode => (
isa => Str,
is => 'rw',
default => 'given',
);
has length => (
isa => CodeRef,
is => 'rw',
default => sub { sub {length shift} },
);
has words_to_use => (
isa => WordListT,
traits => ['Array'],
handles => {
has_next_word => 'count',
get_next_word => 'shift',
},
lazy_build => 1,
clearer => '_reset_wts',
);
has grid_status => (
isa => GridStatusT,
is => 'ro',
lazy_build => 1,
clearer => '_reset_gs',
);
sub _build_words_to_use {
my ($self) = @_;
my $words = $self->words;
my $mode = $self->mode;
my $l = $self->length;
given ($mode) {
when ('random') { return [ shuffle uniq @$words ] }
when ('given') { return [ uniq @$words ] }
when ('longest') { return [ sort {$l->($b) <=> $l->($a)} uniq @$words ] }
when ('shortest') { return [ sort {$l->($a) <=> $l->($b)} uniq @$words ] }
default { croak "Unknown mode $mode" }
}
}
sub _build_grid_status {
my ($self) = @_;
return [
map {
[
map {
$_ eq '*' ? $BLACK : $WHITE
} @$_
]
} @{$self->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..$self->length->($word)-1) {
$self->_mark_occupied($x+$i,$y);
}
}
elsif ($dir == $VERTICAL) {
for my $i (0..$self->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;
}
{
my %symbols=(
$NOTHING => ' ',
$BLACK => 'X',
$WHITE => 'O',
);
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;
}
}
sub reset {
my ($self) = @_;
$self->_reset_gs;
$self->_reset_wts;
}
1;
