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.001';
3 2     2   24 use v5.10;
  2         7  
4 2     2   10 use strict;
  2         8  
  2         54  
5 2     2   11 use warnings;
  2         4  
  2         71  
6              
7 2     2   12 use Moo;
  2         4  
  2         11  
8 2     2   650 use Mooish::AttributeBuilder -standard;
  2         5  
  2         10  
9 2     2   227 use Carp qw(croak);
  2         5  
  2         147  
10              
11 2     2   14 use constant TERRAIN_CLASS => 'terrain';
  2         11  
  2         229  
12 2     2   17 use constant WALL_OBJECT => '';
  2         3  
  2         131  
13 2     2   12 use constant VOID_OBJECT => '0';
  2         4  
  2         1178  
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   22 my $self = shift;
42 2         3 my %classes = %{$self->classes};
  2         16  
43 2         5 my %objects = %{$self->objects};
  2         16  
44 2         4 my %map_reverse;
45              
46 2         11 foreach my $class (keys %classes) {
47 7         10 my @objects = map { $objects{$_} } @{$classes{$class}};
  17         33  
  7         15  
48 7         15 foreach my $obj (@objects) {
49 17         50 $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 321 my ($self, $obj) = @_;
59              
60 185   33     2879 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 18 my ($self, $marker) = @_;
67              
68 2         8 return $self->add_terrain($marker, WALL_OBJECT);
69             }
70              
71             sub add_void
72             {
73 2     2 1 7 my ($self, $marker) = @_;
74              
75 2         5 return $self->add_terrain($marker, VOID_OBJECT);
76             }
77              
78             sub add_terrain
79             {
80 6     6 1 17 my ($self, $marker, $object) = @_;
81              
82 6         13 return $self->add_object(TERRAIN_CLASS, $marker, $object);
83             }
84              
85             sub add_object
86             {
87 17     17 1 35 my ($self, $class, $marker, $object) = @_;
88              
89             croak "marker '$marker' is already used"
90 17 50       65 if exists $self->objects->{$marker};
91              
92 17 50       42 croak "marker '$marker' has wrong length"
93             unless length $marker == $self->characters_per_tile;
94              
95 17         24 push @{$self->classes->{$class}}, $marker;
  17         39  
96 17         37 $self->objects->{$marker} = $object;
97              
98 17         55 return $self;
99             }
100              
101             1;
102              
103             __END__