File Coverage

blib/lib/Games/LMSolve/Tilt/Single.pm
Criterion Covered Total %
statement 15 61 24.5
branch 0 4 0.0
condition 0 9 0.0
subroutine 5 12 41.6
pod 7 7 100.0
total 27 93 29.0


line stmt bran cond sub pod time code
1             package Games::LMSolve::Tilt::Single;
2             $Games::LMSolve::Tilt::Single::VERSION = '0.14.1';
3 1     1   1011 use strict;
  1         2  
  1         29  
4 1     1   5 use warnings;
  1         2  
  1         26  
5              
6 1     1   6 use Games::LMSolve::Tilt::Base;
  1         2  
  1         33  
7              
8 1     1   5 use Games::LMSolve::Input;
  1         3  
  1         40  
9              
10 1     1   6 use vars qw(@ISA);
  1         2  
  1         644  
11              
12             @ISA = qw(Games::LMSolve::Tilt::Base);
13              
14             sub input_board
15             {
16 0     0 1   my $self = shift;
17 0           my $filename = shift;
18              
19 0           my $spec = {
20             'dims' => { 'type' => "xy(integer)", 'required' => 1 },
21             'start' => { 'type' => "xy(integer)", 'required' => 1 },
22             'goal' => { 'type' => "xy(integer)", 'required' => 1 },
23             'layout' => { 'type' => "layout", 'required' => 1 },
24             };
25              
26 0           my $input_obj = Games::LMSolve::Input->new();
27              
28 0           my $input_fields = $input_obj->input_board( $filename, $spec );
29              
30             my ( $width, $height ) =
31 0           @{ $input_fields->{'dims'}->{'value'} }{ 'x', 'y' };
  0            
32             my ( $start_x, $start_y ) =
33 0           @{ $input_fields->{'start'}->{'value'} }{ 'x', 'y' };
  0            
34             my ( $goal_x, $goal_y ) =
35 0           @{ $input_fields->{'goal'}->{'value'} }{ 'x', 'y' };
  0            
36              
37 0 0 0       if ( ( $start_x >= $width ) || ( $start_y >= $height ) )
38             {
39 0           die
40             "The starting position is out of bounds of the board in file \"$filename\"!\n";
41             }
42              
43 0 0 0       if ( ( $goal_x >= $width ) || ( $goal_y >= $height ) )
44             {
45 0           die
46             "The goal position is out of bounds of the board in file \"$filename\"!\n";
47             }
48              
49             my ( $horiz_walls, $vert_walls ) =
50             $input_obj->input_horiz_vert_walls_layout( $width, $height,
51 0           $input_fields->{'layout'} );
52              
53 0           $self->{'width'} = $width;
54 0           $self->{'height'} = $height;
55 0           $self->{'goal_x'} = $goal_x;
56 0           $self->{'goal_y'} = $goal_y;
57 0           $self->{'horiz_walls'} = $horiz_walls;
58 0           $self->{'vert_walls'} = $vert_walls;
59              
60 0           return [ $start_x, $start_y ];
61             }
62              
63             sub pack_state
64             {
65 0     0 1   my $self = shift;
66 0           my $state_vector = shift;
67              
68 0           return pack( "cc", @$state_vector );
69             }
70              
71             sub unpack_state
72             {
73 0     0 1   my $self = shift;
74 0           my $state = shift;
75 0           return [ unpack( "cc", $state ) ];
76             }
77              
78             sub display_state
79             {
80 0     0 1   my $self = shift;
81 0           my $state = shift;
82 0           my ( $x, $y ) = ( map { $_ + 1 } @{ $self->unpack_state($state) } );
  0            
  0            
83 0           return sprintf("($x,$y)");
84             }
85              
86             sub check_if_final_state
87             {
88 0     0 1   my $self = shift;
89              
90 0           my $coords = shift;
91              
92             return ( ( $coords->[0] == $self->{'goal_x'} )
93 0   0       && ( $coords->[1] == $self->{'goal_y'} ) );
94             }
95              
96             sub enumerate_moves
97             {
98 0     0 1   my $self = shift;
99 0           my $coords = shift;
100              
101 0           return (qw(u d l r));
102             }
103              
104             sub perform_move
105             {
106 0     0 1   my $self = shift;
107              
108 0           my $coords = shift;
109 0           my $move = shift;
110              
111 0           my ( $new_coords, $intermediate_states ) =
112             $self->move_ball_to_end( $coords, $move );
113              
114 0           return $new_coords;
115             }
116              
117             1;
118              
119             __END__