File Coverage

blib/lib/Game/TileMap/Legend.pm
Criterion Covered Total %
statement 54 54 100.0
branch 2 4 50.0
condition 1 3 33.3
subroutine 15 15 100.0
pod 5 5 100.0
total 77 81 95.0


line stmt bran cond sub pod time code
1             package Game::TileMap::Legend;
2             $Game::TileMap::Legend::VERSION = '0.002';
3 2     2   30 use v5.10;
  2         8  
4 2     2   11 use strict;
  2         11  
  2         55  
5 2     2   11 use warnings;
  2         4  
  2         73  
6              
7 2     2   17 use Moo;
  2         6  
  2         13  
8 2     2   658 use Mooish::AttributeBuilder -standard;
  2         6  
  2         16  
9 2     2   230 use Carp qw(croak);
  2         4  
  2         110  
10              
11 2     2   23 use constant TERRAIN_CLASS => 'terrain';
  2         4  
  2         207  
12 2     2   12 use constant WALL_OBJECT => '';
  2         4  
  2         171  
13 2     2   13 use constant VOID_OBJECT => '0';
  2         6  
  2         1240  
14              
15             has field 'classes' => (
16             default => sub { {} },
17              
18             # isa => HashRef [ ArrayRef [Str]],
19             );
20              
21             has param 'characters_per_tile' => (
22             default => sub { 1 },
23              
24             # isa => PositiveInt,
25             );
26              
27             has field '_object_map' => (
28             lazy => 1,
29              
30             # isa => HashRef [Str],
31             );
32              
33             has field 'objects' => (
34             default => sub { {} },
35              
36             # isa => HashRef [Any],
37             );
38              
39             sub _build_object_map
40             {
41 2     2   24 my $self = shift;
42 2         4 my %classes = %{$self->classes};
  2         17  
43 2         5 my %objects = %{$self->objects};
  2         18  
44 2         4 my %map_reverse;
45              
46 2         9 foreach my $class (keys %classes) {
47 7         9 my @objects = map { $objects{$_} } @{$classes{$class}};
  17         34  
  7         16  
48 7         14 foreach my $obj (@objects) {
49 17         55 $map_reverse{$obj} = $class;
50             }
51             }
52              
53 2         22 return \%map_reverse;
54             }
55              
56             sub get_class_of_object
57             {
58 185     185 1 322 my ($self, $obj) = @_;
59              
60 185   33     2865 return $self->_object_map->{$obj}
61             // croak "no such object '$obj' in map legend";
62             }
63              
64             sub add_wall
65             {
66 2     2 1 17 my ($self, $marker) = @_;
67              
68 2         9 return $self->add_terrain($marker, WALL_OBJECT);
69             }
70              
71             sub add_void
72             {
73 2     2 1 6 my ($self, $marker) = @_;
74              
75 2         6 return $self->add_terrain($marker, VOID_OBJECT);
76             }
77              
78             sub add_terrain
79             {
80 6     6 1 15 my ($self, $marker, $object) = @_;
81              
82 6         14 return $self->add_object(TERRAIN_CLASS, $marker, $object);
83             }
84              
85             sub add_object
86             {
87 17     17 1 36 my ($self, $class, $marker, $object) = @_;
88              
89             croak "marker '$marker' is already used"
90 17 50       42 if exists $self->objects->{$marker};
91              
92 17 50       43 croak "marker '$marker' has wrong length"
93             unless length $marker == $self->characters_per_tile;
94              
95 17         22 push @{$self->classes->{$class}}, $marker;
  17         43  
96 17         42 $self->objects->{$marker} = $object;
97              
98 17         51 return $self;
99             }
100              
101             1;
102              
103             __END__