File Coverage

lib/Catan/Map/Intersection.pm
Criterion Covered Total %
statement 18 44 40.9
branch 0 14 0.0
condition 0 21 0.0
subroutine 6 10 60.0
pod 0 4 0.0
total 24 93 25.8


line stmt bran cond sub pod time code
1             package Catan::Map::Intersection;
2             $Catan::Map::Intersection::VERSION = '0.02';
3 3     3   15 use strict;
  3     1   5  
  3         76  
  1         1090  
  1         2  
  1         29  
4 3     3   22 use warnings;
  3     1   4  
  3         94  
  1         5  
  1         2  
  1         36  
5              
6             use overload
7 3         16 '""' => 'uuid',
  1         7  
8 3     3   25 fallback => 1;
  3     1   6  
  1         5  
  1         2  
9              
10             sub new
11             {
12 0     0 0   my ($class, $tiles) = @_;
13              
14 0 0 0       die 'Intersection->new() requires an arrayref of 3 tiles'
      0        
15             unless $tiles && ref $tiles eq 'ARRAY' && @$tiles == 3;
16              
17             # check tiles are joined
18 0           for my $t1 (@$tiles)
19             {
20 0           for my $t2 (@$tiles)
21             {
22 0 0 0       die 'Invalid intersection - all 3 tiles must be next to each other'
23             unless $t1 eq $t2 || $t1->hex_distance($t2) == 1;
24             }
25             }
26              
27             bless {
28             location => $tiles,
29 0           uuid => join('|', map {$_->id} sort {$a->id cmp $b->id} @$tiles),
  0            
  0            
30             }, $class;
31             }
32              
33 0     0 0   sub uuid { $_[0]->{uuid} }
34              
35             sub is_colliding
36             {
37 0     0 0   my ($self, $location) = @_;
38              
39 0 0 0       die 'is_colliding requires an Intersection or Path object as an argument'
      0        
40             unless $location && ($location->isa('Catan::Map::Intersection')
41             || $location->isa('Catan::Map::Path'));
42 0 0         return $location->isa('Catan::Map::Path')
43             ? $location->is_colliding($self)
44             : $self eq $location;
45             }
46              
47             sub is_adjacent
48             {
49 0     0 0   my ($self, $location) = @_;
50              
51 0 0 0       die 'is_adjacent requires an Intersection or tile object as an argument'
      0        
52             unless $location
53             && ( $location->isa('Catan::Map::Intersection')
54             || $location->isa('Catan::Map::Tile'));
55              
56 0           my ($matching_tiles, $tiles_to_match) = (0);
57 0 0         if ($location->isa('Catan::Map::Intersection'))
58             {
59 0           $tiles_to_match = 2;
60              
61             # intersections are adjacent if they share 2 coordinates with the intersection
62 0           for my $hex (@{$self->{location}})
  0            
63             {
64 0           $matching_tiles += grep($hex eq $_, @{$location->{location}});
  0            
65             }
66             }
67             else
68             {
69 0           $tiles_to_match = 1;
70             # tiles are adjacent if they share 1 coordinate with the intersection
71 0           for my $tile (@{$self->{location}})
  0            
72             {
73 0 0         $matching_tiles += $tile eq $location ? 1 : 0;
74             }
75             }
76 0           return $matching_tiles == $tiles_to_match;
77             }
78              
79             1;
80              
81             __END__