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 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],
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 {
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();
while ($self->_unfilled() && $self->_has_next_word()) {
my $word = $self->_get_next_word();
$self->log->debug("Placing $word");
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,$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);
}
}
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) = @_;
return $colourmap{$self->grid->[$y][$x]}->{$dir}->{
($dir == $HORIZONTAL) ? ($y % 2) : ($x % 2)
};
}
}
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);
}
}
1;