File Coverage

blib/lib/Game/TextPacMonster/L.pm
Criterion Covered Total %
statement 38 38 100.0
branch 8 8 100.0
condition n/a
subroutine 8 8 100.0
pod 0 2 0.0
total 54 56 96.4


line stmt bran cond sub pod time code
1             package Game::TextPacMonster::L;
2              
3 4     4   700 use strict;
  4         6  
  4         97  
4 4     4   21 use warnings;
  4         7  
  4         87  
5 4     4   21 use utf8;
  4         6  
  4         26  
6              
7 4     4   542 use Game::TextPacMonster::Point;
  4         8  
  4         400  
8              
9 4     4   26 use base 'Game::TextPacMonster::Creature';
  4         8  
  4         1707  
10              
11             sub new {
12 30     30 0 69 my $class = shift @_;
13 30         144 my $self = $class->SUPER::new(@_);
14             }
15              
16              
17             sub move_free {
18 16     16 0 30 my $self = shift;
19              
20 16         60 my $pre_p = $self->pre_point;
21 16         44 my $now_p = $self->point;
22              
23 16         44 my $relative_point_x = $now_p->x_coord - $pre_p->x_coord;
24 16         39 my $relative_point_y = $now_p->y_coord - $pre_p->y_coord;
25              
26 16         23 my $orientation = q{}; # an empty string;
27              
28 16 100       32 if ($relative_point_y == 0) {
29 8 100       19 $orientation = $relative_point_x > 0 ? 'left_to_right' : 'right_to_left';
30             }
31             else {
32 8 100       24 $orientation = $relative_point_y > 0 ? 'up_to_down' : 'down_to_up';
33             }
34              
35 16         40 my %next_rules = $self->_make_rules;
36 16         24 my @next_rule = @{$next_rules{$orientation}};
  16         41  
37              
38 16         24 for my $rule (@next_rule) {
39 36 100       117 return 1 if $self->$rule;
40             }
41              
42 4         27 return 0;
43             }
44              
45             sub _make_rules {
46 16     16   27 my %rules = ();
47              
48             # L will face to move left, front, right
49 16         42 $rules{left_to_right} = [ 'move_up', 'move_right', 'move_down' ];
50 16         44 $rules{right_to_left} = [ 'move_down', 'move_left', 'move_up' ];
51 16         32 $rules{up_to_down} = [ 'move_right', 'move_down', 'move_left' ];
52 16         33 $rules{down_to_up} = [ 'move_left', 'move_up', 'move_right' ];
53              
54 16         69 return %rules;
55             }
56              
57              
58             1;