From 568ab037eb9190f83f31b7f775640b6eee46da1c Mon Sep 17 00:00:00 2001 From: dakkar Date: Thu, 2 Dec 2010 21:00:03 +0000 Subject: factored out text result class --- lib/GridFiller.pm | 6 +- lib/GridFiller/Result.pm | 121 +----------------------------------- lib/GridFiller/Result/Text.pm | 138 ++++++++++++++++++++++++++++++++++++++++++ lib/GridFiller/Types.pm | 4 +- 4 files changed, 145 insertions(+), 124 deletions(-) create mode 100644 lib/GridFiller/Result/Text.pm diff --git a/lib/GridFiller.pm b/lib/GridFiller.pm index c21168f..9644da3 100644 --- a/lib/GridFiller.pm +++ b/lib/GridFiller.pm @@ -1,10 +1,10 @@ package GridFiller; use Moose; use namespace::autoclean; -use GridFiller::Types qw(GridT WordListT ResultT GridStatusT); +use GridFiller::Types qw(GridT WordListT ); use MooseX::Types::Moose qw(CodeRef); use GridFiller::Status; -use GridFiller::Result; +use GridFiller::Result::Text; use GridFiller::Chooser::Smarter; use Carp; use Class::MOP; @@ -59,7 +59,7 @@ has result => ( sub _build_result { my ($self) = @_; - return GridFiller::Result->new({ + return GridFiller::Result::Text->new({ source_grid => $self->grid, }); } diff --git a/lib/GridFiller/Result.pm b/lib/GridFiller/Result.pm index 3a2a505..4ba3736 100644 --- a/lib/GridFiller/Result.pm +++ b/lib/GridFiller/Result.pm @@ -1,7 +1,7 @@ package GridFiller::Result; use Moose; use namespace::autoclean; -use GridFiller::Types qw(GridT ResultT WordListT); +use GridFiller::Types qw(GridT WordListT); use GridFiller::Constants ':directions'; use Carp; @@ -22,136 +22,19 @@ sub _build_leftover_words { return [ ]; } -has grid => ( - isa => ResultT, - is => 'ro', - lazy_build => 1, - clearer => '_reset_g', -); - has source_grid => ( isa => GridT, is => 'ro', required => 1, ); -{ -my %colourmap = ( - '*' => { - $HORIZONTAL => { - 0 => 1, - 1 => 2, - }, - $VERTICAL => { - 0 => 3, - 1 => 4, - }, - }, - ' ' => { - $HORIZONTAL => { - 0 => 5, - 1 => 6, - }, - $VERTICAL => { - 0 => 7, - 1 => 8, - }, - }, -); - -sub _build_grid { - return [ - map { - [ - map { - [ $colourmap{$_}->{$HORIZONTAL}->{0}, ' ' ], - } @$_ - ] - } @{shift->source_grid} - ]; -} - -sub _find_colour_for { - my ($self,$x,$y,$dir) = @_; - - my $parity = ($dir == $HORIZONTAL) ? ($y % 2) : ($x % 2); - - my $chosen = $colourmap{$self->source_grid->[$y][$x]}->{$dir}->{$parity}; - - # avoid colour runs - if ( ( $x>0 && $dir == $HORIZONTAL && $self->grid->[$y][$x-1][0] == $chosen ) - or - ( $y>0 && $dir == $VERTICAL && $self->grid->[$y-1][$x][0] == $chosen ) - ) { - $chosen = $colourmap{$self->source_grid->[$y][$x]}->{$dir}->{1-$parity}; - } - - if (!defined $chosen) { - $self->log->warn(sprintf(q{Can't decide on colour for %d:%d (%s) direction %d}, - $x,$y,$self->source_grid->[$y][$x],$dir)); - } - - return $chosen; -} -} - 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->_put_letter_at(substr($word,$i,1), - $x+$i,$y, - $colour); - } - } - elsif ($dir == $VERTICAL) { - for my $i (0..length($word)-1) { - $self->_put_letter_at(substr($word,$i,1), - $x,$y+$i, - $colour); - } - } - else { - croak "What dir $dir?"; - } -} - -sub _put_letter_at { - my ($self,$letter,$x,$y,$colour) = @_; - - croak "undef colour" unless defined $colour; - croak "undef letter" unless defined $letter; - - $self->grid->[$y][$x]=[$colour,$letter]; - return; -} - -sub to_string { - my ($self) = @_; - - my $rows = scalar @{$self->grid}; - - my $str; - - for my $row (0..$rows-1) { - for my $cell (@{$self->grid->[$row]}) { - $str .= $cell->[1] eq ' ' ? '.' : $cell->[1]; - } - $str .= "\n"; - } - - return $str; + die "unimplemented"; } sub reset { my ($self) = @_; - $self->_reset_g; $self->_reset_lw; return; diff --git a/lib/GridFiller/Result/Text.pm b/lib/GridFiller/Result/Text.pm new file mode 100644 index 0000000..fb72ccb --- /dev/null +++ b/lib/GridFiller/Result/Text.pm @@ -0,0 +1,138 @@ +package GridFiller::Result::Text; +use Moose; +use namespace::autoclean; +use GridFiller::Types qw(TextResultT); +use GridFiller::Constants ':directions'; +use Carp; + +extends 'GridFiller::Result'; + +with 'MooseX::Log::Log4perl'; + +has grid => ( + isa => TextResultT, + is => 'ro', + lazy_build => 1, + clearer => '_reset_g', +); + + +{ +my %colourmap = ( + '*' => { + $HORIZONTAL => { + 0 => 1, + 1 => 2, + }, + $VERTICAL => { + 0 => 3, + 1 => 4, + }, + }, + ' ' => { + $HORIZONTAL => { + 0 => 5, + 1 => 6, + }, + $VERTICAL => { + 0 => 7, + 1 => 8, + }, + }, +); + +sub _build_grid { + return [ + map { + [ + map { + [ $colourmap{$_}->{$HORIZONTAL}->{0}, ' ' ], + } @$_ + ] + } @{shift->source_grid} + ]; +} + +sub _find_colour_for { + my ($self,$x,$y,$dir) = @_; + + my $parity = ($dir == $HORIZONTAL) ? ($y % 2) : ($x % 2); + + my $chosen = $colourmap{$self->source_grid->[$y][$x]}->{$dir}->{$parity}; + + # avoid colour runs + if ( ( $x>0 && $dir == $HORIZONTAL && $self->grid->[$y][$x-1][0] == $chosen ) + or + ( $y>0 && $dir == $VERTICAL && $self->grid->[$y-1][$x][0] == $chosen ) + ) { + $chosen = $colourmap{$self->source_grid->[$y][$x]}->{$dir}->{1-$parity}; + } + + if (!defined $chosen) { + $self->log->warn(sprintf(q{Can't decide on colour for %d:%d (%s) direction %d}, + $x,$y,$self->source_grid->[$y][$x],$dir)); + } + + return $chosen; +} +} + +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->_put_letter_at(substr($word,$i,1), + $x+$i,$y, + $colour); + } + } + elsif ($dir == $VERTICAL) { + for my $i (0..length($word)-1) { + $self->_put_letter_at(substr($word,$i,1), + $x,$y+$i, + $colour); + } + } + else { + croak "What dir $dir?"; + } +} + +sub _put_letter_at { + my ($self,$letter,$x,$y,$colour) = @_; + + croak "undef colour" unless defined $colour; + croak "undef letter" unless defined $letter; + + $self->grid->[$y][$x]=[$colour,$letter]; + return; +} + +sub to_string { + my ($self) = @_; + + my $rows = scalar @{$self->grid}; + + my $str; + + for my $row (0..$rows-1) { + for my $cell (@{$self->grid->[$row]}) { + $str .= $cell->[1] eq ' ' ? '.' : $cell->[1]; + } + $str .= "\n"; + } + + return $str; +} + +after reset => sub { + my ($self) = @_; + $self->_reset_g; +}; + +1; diff --git a/lib/GridFiller/Types.pm b/lib/GridFiller/Types.pm index 8beb715..92834ba 100644 --- a/lib/GridFiller/Types.pm +++ b/lib/GridFiller/Types.pm @@ -2,7 +2,7 @@ package GridFiller::Types; use MooseX::Types -declare => [qw( GridT GridStatusT - CharT LetterCellT ResultT + CharT LetterCellT TextResultT WordListT )]; use MooseX::Types::Moose qw(Str ArrayRef Int); @@ -21,6 +21,6 @@ subtype GridStatusT, as ArrayRef[ArrayRef[Int]]; subtype WordListT, as ArrayRef[Str]; -subtype ResultT, as ArrayRef[ArrayRef[LetterCellT]]; +subtype TextResultT, as ArrayRef[ArrayRef[LetterCellT]]; 1; -- cgit v1.2.3