package GridFiller;
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;
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 '*'
} @$_
]
} @$_
]
};
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 {
$_ ? $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 _build_result {
return [
map {
[
map {
[0,' '],
} @$_
]
} @{shift->grid}
];
}
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();
my ($x,$y,$dir);
try { ($x,$y,$dir) = $self->_find_place_for($word) }
catch {
$self->_mark_leftover($word);
next;
};
$self->_place_word_at($word,$x,$y,$dir);
}
}
sub _place_word_at {
my ($self, $word, $x, $y, $dir) = @_;
my $colour = $self->_find_colour_for($x,$y);
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 _put_letter_at {
my ($self,$letter,$x,$y,$colour) = @_;
$self->result()->[$y][$x]=[$colour,$letter];
return;
}
sub _find_colour_for {
my ($self,$x,$y,$dir) = @_;
if ($dir == $HORIZONTAL) {
return $self->grid->[$y][$x]==$WHITE ? 1 : 3;
}
else {
return $self->grid->[$y][$x]==$WHITE ? 2 : 4;
}
}
sub _find_place_for {
my ($self,$word) = @_;
my $dir = int(rand(2)) > 1 ? $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;
}
die "No place for $word" unless @ret;
return @ret;
}
sub _find_place_horiz {
my ($self,$length) = @_;
my $cols = scalar @{$self->grid->[0]};
my $col;
for my $row (0..$cols) {
$col = $self->_find_in_row($row,$length);
return ($row,$col,$HORIZONTAL) if defined $col;
}
return;
}
sub _find_place_vert {
my ($self,$length) = @_;
my $rows = scalar @{$self->grid};
my $row;
for my $col (0..$rows) {
$row = $self->_find_in_col($col,$length);
return ($row,$col,$VERTICAL) if defined $row;
}
return;
}
sub _find_in_row {
my ($self,$row,$length) = @_;
my $str = join '',map { $_ ? '*' : ' ' } @{$self->_grid_status->[$row]};
my ($skip) = ($str =~ m{^ (.*?) (?: \*{$length})}x);
return length($skip) if defined $skip;
return;
}
sub _find_in_col {
my ($self,$col,$length) = @_;
my $str = join '',map { $_->[$col] ? '*' : ' ' } @{$self->_grid_status};
my ($skip) = ($str =~ m{^ (.*?) (?: \*{$length})}x);
return length($skip) if defined $skip;
return;
}
sub _unfilled {
my ($self) = @_;
for my $row (@{$self->_grid_status}) {
for my $cell (@$row) {
return 1 if $cell != 0;
}
}
return 0;
}
1;