diff options
Diffstat (limited to 'lib/GridFiller.pm')
-rw-r--r-- | lib/GridFiller.pm | 118 |
1 files changed, 72 insertions, 46 deletions
diff --git a/lib/GridFiller.pm b/lib/GridFiller.pm index d036094..ebeb933 100644 --- a/lib/GridFiller.pm +++ b/lib/GridFiller.pm @@ -3,33 +3,20 @@ 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; +with 'MooseX::Log::Log4perl'; + 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 '*' - } @$_ - ] - } @$_ - ] - }; +subtype GridT, as ArrayRef[ArrayRef[Str]]; has words => ( isa => ArrayRef[Str], @@ -82,7 +69,7 @@ sub _build__grid_status { map { [ map { - $_ ? $BLACK : $WHITE + $_ eq '*' ? $BLACK : $WHITE } @$_ ] } @{shift->grid} @@ -108,7 +95,7 @@ sub _build_result { map { [ map { - [0,' '], + [ ( $_ eq '*' ? 3 : 1 ), ' ' ], } @$_ ] } @{shift->grid} @@ -132,22 +119,30 @@ sub fill { while ($self->_unfilled() && $self->_has_next_word()) { my $word = $self->_get_next_word(); - my ($x,$y,$dir); + $self->log->debug("Placing $word"); - try { ($x,$y,$dir) = $self->_find_place_for($word) } - catch { + 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); + 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) { @@ -177,6 +172,17 @@ sub _mark_occupied { 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) = @_; @@ -189,17 +195,17 @@ sub _find_colour_for { # let's be easy if ($dir == $HORIZONTAL) { - return $self->grid->[$y][$x]==$WHITE ? 1 : 3; + return $self->grid->[$y][$x] eq '*' ? 3 : 1; } else { - return $self->grid->[$y][$x]==$WHITE ? 2 : 4; + return $self->grid->[$y][$x] eq '*' ? 4 : 2; } } sub _find_place_for { my ($self,$word) = @_; - my $dir = int(rand(2)) > 1 ? $HORIZONTAL : $VERTICAL; + my $dir = int(rand(2)) ? $HORIZONTAL : $VERTICAL; my $length = length $word; @@ -214,20 +220,18 @@ sub _find_place_for { @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 $rows = scalar @{$self->grid}; my $col; - for my $row (0..$cols) { + for my $row (0..$rows-1) { $col = $self->_find_in_row($row,$length); - return ($row,$col,$HORIZONTAL) if defined $col; + return ($col,$row,$HORIZONTAL) if defined $col; } return; } @@ -235,47 +239,69 @@ sub _find_place_horiz { sub _find_place_vert { my ($self,$length) = @_; - my $rows = scalar @{$self->grid}; + my $cols = scalar @{$self->grid->[0]}; my $row; - for my $col (0..$rows) { + for my $col (0..$cols-1) { $row = $self->_find_in_col($col,$length); - return ($row,$col,$VERTICAL) if defined $row; + return ($col,$row,$VERTICAL) if defined $row; } return; } -sub _find_in_row { - my ($self,$row,$length) = @_; +{ +my @symbols=(' ','X','O'); + +sub _do_find { + my ($self,$str,$length) = @_; - my $str = join '',map { $_ ? '*' : ' ' } @{$self->_grid_status->[$row]}; + my ($skip) = ($str =~ m{^ (.*?) (?: X{$length} | O{$length} ) }x); - my ($skip) = ($str =~ m{^ (.*?) (?: \*{$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 { $_->[$col] ? '*' : ' ' } @{$self->_grid_status}; + my $str = join '',map { $symbols[$_->[$col]] } @{$self->_grid_status}; - my ($skip) = ($str =~ m{^ (.*?) (?: \*{$length})}x); + $self->log->debug("col $col = $str"); - return length($skip) if defined $skip; - return; + return $self->_do_find($str,$length); } -sub _unfilled { +sub _log_status { my ($self) = @_; - for my $row (@{$self->_grid_status}) { - for my $cell (@$row) { - return 1 if $cell != 0; + 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"; } - return 0; + $self->log->debug($str); +} } 1; |