File Coverage

blib/lib/Game/TileMap/Legend.pm

Criterion	Covered	Total	%
statement	60	60	100.0
branch	2	4	50.0
condition	5	7	71.4
subroutine	15	15	100.0
pod	5	5	100.0
total	87	91	95.6

package Game::TileMap::Legend;
$Game::TileMap::Legend::VERSION = '1.000';
use v5.10;
use strict;
use warnings;

use Moo;
use Mooish::AttributeBuilder -standard;
use Carp qw(croak);

use constant TERRAIN_CLASS => 'terrain';
use constant WALL_OBJECT => 'wall';
use constant VOID_OBJECT => 'void';

has field 'classes' => (
	default => sub { {} },

	# isa => HashRef [ ArrayRef [Str]],
);

has param 'characters_per_tile' => (
	default => sub { 1 },

	# isa => PositiveInt,
);

has field '_object_map' => (
	lazy => 1,

	# isa => HashRef [Str],
);

has field 'objects' => (
	default => sub { {} },

	# isa => HashRef [Any],
);

has field 'walls' => (
	default => sub { {} },

	# isa => HashRef [Bool],
);

has field 'voids' => (
	default => sub { {} },

	# isa => HashRef [Bool],
);

sub _build_object_map
{
	my $self = shift;
	my %classes = %{$self->classes};
	my %objects = %{$self->objects};
	my %map_reverse;

	foreach my $class (keys %classes) {
		my @objects = map { $objects{$_} } @{$classes{$class}};
		foreach my $obj (@objects) {
			$map_reverse{$obj} = $class;
		}
	}

	return \%map_reverse;
}

sub get_class_of_object
{
	my ($self, $obj) = @_;

	return $self->_object_map->{$obj}
		// croak "no such object '$obj' in map legend";
}

sub add_wall
{
	my ($self, $marker, $object) = @_;
	$object //= WALL_OBJECT;

	$self->add_terrain($marker, $object);
	$self->walls->{$object} = !!1;
	return $self;
}

sub add_void
{
	my ($self, $marker, $object) = @_;
	$object //= VOID_OBJECT;

	$self->add_terrain($marker, $object);
	$self->voids->{$object} = !!1;
	return $self;
}

sub add_terrain
{
	my ($self, $marker, $object) = @_;

	return $self->add_object(TERRAIN_CLASS, $marker, $object);
}

sub add_object
{
	my ($self, $class, $marker, $object) = @_;

	croak "marker '$marker' is already used"
		if exists $self->objects->{$marker};

	croak "marker '$marker' has wrong length"
		unless length $marker == $self->characters_per_tile;

	push @{$self->classes->{$class}}, $marker;
	$self->objects->{$marker} = $object;

	return $self;
}

1;

__END__