package Games::LMSolve::Tilt::RedBlue; use strict; use Games::LMSolve::Tilt::Base; use Games::LMSolve::Input; use vars qw(@ISA); @ISA=qw(Games::LMSolve::Tilt::Base); sub input_board { my $self = shift; my $filename = shift; my $spec = { 'dims' => { 'type' => "xy(integer)", 'required' => 1 }, 'red_start' => { 'type' => "xy(integer)", 'required' => 1 }, 'red_goal' => {'type' => "xy(integer)", 'required' => 1 }, 'blue_start' => { 'type' => "xy(integer)", 'required' => 1 }, 'blue_goal' => {'type' => "xy(integer)", 'required' => 1 }, '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 ($red_start_x, $red_start_y) = @{$input_fields->{'red_start'}->{'value'}}{'x','y'}; my ($red_goal_x, $red_goal_y) = @{$input_fields->{'red_goal'}->{'value'}}{'x','y'}; my ($blue_start_x, $blue_start_y) = @{$input_fields->{'blue_start'}->{'value'}}{'x','y'}; my ($blue_goal_x, $blue_goal_y) = @{$input_fields->{'blue_goal'}->{'value'}}{'x','y'}; if (($red_start_x >= $width) || ($red_start_y >= $height)) { die "The starting position of the red block is out of bounds of the board in file \"$filename\"!\n"; } if (($red_goal_x >= $width) || ($red_goal_y >= $height)) { die "The goal position of the red block is out of bounds of the board in file \"$filename\"!\n"; } if (($blue_start_x >= $width) || ($blue_start_y >= $height)) { die "The starting position of the blue block is out of bounds of the board in file \"$filename\"!\n"; } if (($blue_goal_x >= $width) || ($blue_goal_y >= $height)) { die "The goal position of the blue block 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->{'goals'} = [$red_goal_x, $red_goal_y, $blue_goal_x, $blue_goal_y]; $self->{'horiz_walls'} = $horiz_walls; $self->{'vert_walls'} = $vert_walls; return [ $red_start_x, $red_start_y, $blue_start_x, $blue_start_y]; } sub pack_state { my $self = shift; my $state_vector = shift; return pack("cccc", @$state_vector); } sub unpack_state { my $self = shift; my $state = shift; return [ unpack("cccc", $state) ]; } sub display_state { my $self = shift; my $state = shift; my ($rx, $ry, $bx, $by) = (map { $_ + 1} @{$self->unpack_state($state)}); return ("Red=($rx,$ry) ; Blue=($bx,$by)"); } 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 (join(",", @$coords) eq join(",", @{$self->{'goals'}})); } sub enumerate_moves { my $self = shift; my $coords = shift; return (qw(u d l r)); } sub perform_move { my $self = shift; my $coords = shift; my $move = shift; my ($rx, $ry, $bx, $by) = @$coords; my ($red_new_coords, $red_intermediate_states) = $self->move_ball_to_end([ $rx, $ry], $move); my ($blue_new_coords, $blue_intermediate_states) = $self->move_ball_to_end([ $bx, $by], $move); return [ @$red_new_coords, @$blue_new_coords ]; } 1; =head1 NAME Games::LMSolve::Tilt::RedBlue - driver for solving the red blue tilt puzzles =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. For more about red-blue tilt mazes see: L =head1 AUTHORS Shlomi Fish, L =cut