summaryrefslogtreecommitdiff
path: root/lib/GridFiller.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/GridFiller.pm')
-rw-r--r--lib/GridFiller.pm313
1 files changed, 15 insertions, 298 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;
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-19 13:38:57 +0000