factored out text result class

1 files changed, 138 insertions, 0 deletions

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;