package Games::LMSolve::Minotaur;
use strict;
use warnings;
use Games::LMSolve::Base;
use Games::LMSolve::Input;
use vars qw(@ISA);
@ISA=qw(Games::LMSolve::Base);
sub input_board
{
my $self = shift;
my $filename = shift;
my $spec =
{
(map { $_ => { 'type' => "xy(integer)", 'required' => 1} } (qw(dims thes mino exit))),
'layout' => { 'type' => "layout", 'required' => 1},
};
my $input_obj = Games::LMSolve::Input->new();
my $input_fields = $input_obj->input_board($filename, $spec);
my ($width, $height) = @{$input_fields->{'dims'}->{'value'}}{'x','y'};
my ($thes_x, $thes_y) = @{$input_fields->{'thes'}->{'value'}}{'x','y'};
my ($mino_x, $mino_y) = @{$input_fields->{'mino'}->{'value'}}{'x','y'};
my ($exit_x, $exit_y) = @{$input_fields->{'exit'}->{'value'}}{'x','y'};
if (($thes_x >= $width) || ($thes_y >= $height))
{
die "Theseus is out of bounds of the board in file \"$filename\"!\n";
}
if (($mino_x >= $width) || ($mino_y >= $height))
{
die "The minotaur is out of bounds of the board in file \"$filename\"!\n";
}
if (($exit_x >= $width) || ($exit_y >= $height))
{
die "The exit is out of bounds of the board in file \"$filename\"!\n";
}
my ($horiz_walls, $vert_walls) =
$input_obj->input_horiz_vert_walls_layout($width, $height, $input_fields->{'layout'});
$self->{'width'} = $width;
$self->{'height'} = $height;
$self->{'exit_x'} = $exit_x;
$self->{'exit_y'} = $exit_y;
$self->{'horiz_walls'} = $horiz_walls;
$self->{'vert_walls'} = $vert_walls;
return [ $thes_x, $thes_y, $mino_x, $mino_y ];
}
sub _mino_move
{
my $self = shift;
my $horiz_walls = $self->{'horiz_walls'};
my $vert_walls = $self->{'vert_walls'};
my ($thes_x, $thes_y, $mino_x, $mino_y) = @_;
for(my $t=0;$t<2;$t++)
{
if (($thes_x < $mino_x) && (! $vert_walls->[$mino_y][$mino_x]))
{
$mino_x--;
}
elsif (($thes_x > $mino_x) && (! $vert_walls->[$mino_y][$mino_x+1]))
{
$mino_x++;
}
elsif (($thes_y < $mino_y) && (! $horiz_walls->[$mino_y][$mino_x]))
{
$mino_y--;
}
elsif (($thes_y > $mino_y) && (! $horiz_walls->[$mino_y+1][$mino_x]))
{
$mino_y++;
}
}
return ($mino_x, $mino_y);
}
# A function that accepts the expanded state (as an array ref)
# and returns an atom that represents it.
sub pack_state
{
my $self = shift;
my $state_vector = shift;
return pack("cccc", @{$state_vector});
}
# A function that accepts an atom that represents a state
# and returns an array ref that represents it.
sub unpack_state
{
my $self = shift;
my $state = shift;
return [ unpack("cccc", $state) ];
}
# Accept an atom that represents a state and output a
# user-readable string that describes it.
sub display_state
{
my $self = shift;
my $state = shift;
my ($x, $y, $mx,$my) = (map { $_ + 1} @{ $self->unpack_state($state) });
return sprintf("Thes=(%i,%i) Mino=(%i,%i)", $x, $y, $mx,$my);
}
# This function checks if a state it receives as an argument is a
# dead-end one.
sub check_if_unsolvable
{
my $self = shift;
my $coords = shift;
return (($coords->[0] == $coords->[2]) && ($coords->[1] == $coords->[3]));
}
sub check_if_final_state
{
my $self = shift;
my $coords = shift;
return (($coords->[0] == $self->{'exit_x'}) && ($coords->[1] == $self->{'exit_y'}));
}
# This function enumerates the moves accessible to the state.
# If it returns a move, it still does not mean that it is a valid
# one. I.e: it is possible that it is illegal to perform it.
sub enumerate_moves
{
my $self = shift;
my $horiz_walls = $self->{'horiz_walls'};
my $vert_walls = $self->{'vert_walls'};
my $coords = shift;
my ($thes_x, $thes_y) = @$coords[0..1];
my @moves;
if (! $vert_walls->[$thes_y][$thes_x])
{
push @moves, "l";
}
if (! $vert_walls->[$thes_y][$thes_x+1])
{
push @moves, "r";
}
if (! $horiz_walls->[$thes_y][$thes_x])
{
push @moves, "u";
}
if (! $horiz_walls->[$thes_y+1][$thes_x])
{
push @moves, "d";
}
push @moves, "w";
return @moves;
}
my %translate_moves =
(
"u" => [0, -1],
"d" => [0, 1],
"l" => [-1,0],
"r" => [1,0],
"w" => [0,0],
);
# This function accepts a state and a move. It tries to perform the
# move on the state. If it is succesful, it returns the new state.
#
# Else, it returns undef to indicate that the move is not possible.
sub perform_move
{
my $self = shift;
my $coords = shift;
my $m = shift;
my $offsets = $translate_moves{$m};
my @new_coords = @$coords;
$new_coords[0] += $offsets->[0];
$new_coords[1] += $offsets->[1];
(@new_coords[2 .. 3]) = $self->_mino_move(@new_coords);
return \@new_coords;
}
1;
=head1 NAME
Games::LMSolve::Minotaur - driver for solving the "Theseus and the Minotaur"
mazes.
=head1 SYNOPSIS
NA - should not be used directly.
=head1 METHODS
=head2 $self->input_board()
Overrided.
=head2 $self->pack_state()
Overrided.
=head2 $self->unpack_state()
Overrided.
=head2 $self->display_state()
Overrided.
=head2 $self->check_if_unsolvable()
Overrided.
=head2 $self->check_if_final_state()
Overrided.
=head2 $self->enumerate_moves()
Overrided.
=head2 $self->perform_move()
Overrided.
=head1 SEE ALSO
L<Games::LMSolve::Base>.
L<http://www.logicmazes.com/theseus.html>
=head1 AUTHORS
Shlomi Fish, L<http://www.shlomifish.org/>
=cut