Commits

Anonymous committed 5b0b750

Added tests to the init_state.

  • Participants
  • Parent commits 342d0aa

Comments (0)

Files changed (2)

File modules/Shlomif-Sokoban-Solver/lib/Shlomif/Sokoban/Solver/Board.pm

     width
     _data
     _dests
+    _init_state
 /;
 
 my $dest_place_bits = 0x1;
 my $wall_bits = 0x2;
 
+my $box_bits = 0x1;
+my $reachable_bits = 0x2;
+
 =head1 METHODS
 
 =head2 load($board)
 
 =cut
 
+sub _calc_offset
+{
+    my ($self, $x, $y) = @_;
+
+    return $y*$self->width()+$x;
+}
+
 sub load
 {
     my ($pkg, $contents) = @_;
 
     my $data = "";
 
+    my $init_state = "";
+    my $init_pos;
+
     my $self = 
         $pkg->new(
             height => scalar(@lines),
             width => max(map { scalar(@$_) } @lines),
             _data => \$data,
             _dests => [],
+            _init_state => \$init_state,
         );
 
+
+
     foreach my $y (0 .. $#lines)
     {
         my $l = $lines[$y];
         foreach my $x (0 .. $#$l)
         {
-            my $offset = $y*$self->width()+$x;
+            my $offset = $self->_calc_offset($x, $y);
+
+            # Initialise the init_state block to the default.
+            vec($init_state, $offset, 2) = 0;
             if ($l->[$x] eq "#")
             {
                 vec(${$self->_data()}, $offset, 2) = $wall_bits;
             else
             {
                 vec(${$self->_data()}, $offset, 2) = 0;
+                if ($l->[$x] eq '$')
+                {
+                    vec($init_state, $offset, 2) = $box_bits;
+                }
+                elsif ($l->[$x] eq '@')
+                {
+                    $init_pos = [$x, $y];
+                }
             }
         }
     }
 
+    if (!defined($init_pos))
+    {
+        die "The initial position of the player was not defined.";
+    }
+
+    $self->_mark_reachable(\$init_state, @$init_pos);
+
     return $self;
 }
 
 {
     my ($self, $x, $y) = @_;
 
-    return (vec(${$self->_data()}, $y*$self->width()+$x, 2) == $wall_bits);
+    return (vec(${$self->_data()}, $self->_calc_offset($x,$y), 2) == $wall_bits);
 }
 
 =head2 $board->is_dest($x,$y)
 {
     my ($self, $x, $y) = @_;
 
-    return (vec(${$self->_data()}, $y*$self->width()+$x, 2)
+    return (vec(${$self->_data()}, $self->_calc_offset($x,$y), 2)
             == $dest_place_bits
         );
 }
 
+=head2 $board->is_box($s_ref, $x, $y)
+
+Is ($x,$y) in the state referenced by $s_ref a box?
+
+=cut
+
+sub is_box
+{
+    my ($self, $s_ref, $x, $y) = @_;
+    return (vec($$s_ref, $self->_calc_offset($x,$y), 2) == $box_bits);
+}
+
+=head2 $board->is_reachable($s_ref, $x, $y)
+
+Is ($x,$y) in the state referenced by $s_ref reachable by the player?
+
+=cut
+
+sub is_reachable
+{
+    my ($self, $s_ref, $x, $y) = @_;
+    return (vec($$s_ref, $self->_calc_offset($x,$y), 2) == $reachable_bits);
+}
+
+sub _mark_reachable
+{
+    my ($self, $s_ref, $start_x, $start_y) = @_;
+
+    # Breadth-first search to find all the reachable positions in the board.
+    my @to_check =([$start_x, $start_y]);
+
+    while (my $pos = shift(@to_check))
+    {
+        # Mark as reachable.
+        vec($$s_ref, $self->_calc_offset(@$pos), 2) = $reachable_bits;
+
+        foreach my $offset ([-1,0],[1,0],[0,-1],[0,1])
+        {
+            my @new_pos = ($pos->[0]+$offset->[0], $pos->[1]+$offset->[1]);
+            if (   ($new_pos[0] >= 0)
+                && ($new_pos[1] >= 0)
+                && ($new_pos[0] < $self->width())
+                && ($new_pos[1] < $self->height())
+                && (! $self->is_wall(@new_pos))
+                && (! $self->is_box($s_ref, @new_pos))
+                && (! $self->is_reachable($s_ref, @new_pos))
+               )
+            {
+                push @to_check, \@new_pos;
+            }
+        }
+    }
+
+    return;
+}
 
 =head2 width()
 

File modules/Shlomif-Sokoban-Solver/t/01-loading.t

 use strict;
 use warnings;
 
-use Test::More tests => 13;
+use Test::More tests => 17;
 
 use Shlomif::Sokoban::Solver::Board;
 
     is_deeply($board->_dests(),
         [[4,3], [3,4], [5,4], [4,5]],
     );
+
+    my $ok_box = sub {
+        local $Test::Builder::Level = $Test::Builder::Level + 1;
+        my ($x, $y, $msg) = @_;
+
+        ok ($board->is_box($board->_init_state(), $x, $y), $msg);
+    };
+
+    # TEST
+    $ok_box->(3, 3, "3,3 is a box");
+    # TEST
+    $ok_box->(3, 5, "3,5 is a box");
+    # TEST
+    $ok_box->(5, 3, "5,3 is a box");
+    # TEST
+    $ok_box->(5, 5, "5,5 is a box");
 }