legend results from the CPAN

legend

Game-TileMap

view release on metacpan or search on metacpan

use warnings;

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

use Game::TileMap::Legend;
use Game::TileMap::Tile;

has param 'legend' => (

	# isa => InstanceOf ['Game::TileMap::Legend'],
);

has field 'coordinates' => (
	writer => -hidden,

	# isa => ArrayRef [ArrayRef [Any]],
);

lib/Game/TileMap.pm view on Meta::CPAN

	writer => 1,

	# isa => HashRef [ArrayRef [Tuple [Any, PositiveInt, PositiveInt]]],
);

with qw(
	Game::TileMap::Role::Checks
	Game::TileMap::Role::Helpers
);

sub new_legend
{
	my $self = shift;

	return Game::TileMap::Legend->new(@_);
}

sub BUILD
{
	my ($self, $args) = @_;

lib/Game/TileMap.pm view on Meta::CPAN

			if !ref $args->{map};

		$self->from_array($args->{map})
			if ref $args->{map} eq 'ARRAY';
	}
}

sub from_string
{
	my ($self, $map_str) = @_;
	my $per_tile = $self->legend->characters_per_tile;

	my @map_lines =
		reverse
		grep { length }
		map { s/\s//g; $_ }
		split "\n", $map_str
		;

	my @map;
	foreach my $line (@map_lines) {
		my @objects;
		while (length $line) {
			my $marker = substr $line, 0, $per_tile, '';
			push @objects, ($self->legend->objects->{$marker} // croak "Invalid map marker '$marker'");
		}

		push @map, \@objects;
	}

	return $self->from_array(\@map);
}

sub from_array
{

lib/Game/TileMap.pm view on Meta::CPAN

	my %guide;

	my @new_map;
	foreach my $line (0 .. $#map) {
		croak "invalid map size on line $line"
			if @{$map[$line]} != $map_size[0];

		for my $col (0 .. $#{$map[$line]}) {
			my $prev_obj = $map[$line][$col];
			my $obj = Game::TileMap::Tile->new(
				legend => $self->legend,
				contents => $prev_obj,
				x => $col,
				y => $line,
			);

			$new_map[$col][$line] = $obj;
			push @{$guide{$self->legend->get_class_of_object($prev_obj)}}, $obj;
		}
	}

	$self->_set_coordinates(\@new_map);
	$self->_set_size_x($map_size[0]);
	$self->_set_size_y($map_size[1]);
	$self->_set_guide(\%guide);

	return $self;
}

sub to_string
{
	return shift->to_string_and_mark;
}

sub to_string_and_mark
{
	my ($self, $mark_positions, $with) = @_;
	$with //= '!' x $self->legend->characters_per_tile;

	my @lines;
	my %markers_rev = map {
		$self->legend->objects->{$_} => $_
	} keys %{$self->legend->objects};

	my $mark = \undef;
	my $coordinates = $self->coordinates;
	if ($mark_positions) {
		$coordinates = dclone $coordinates;

		foreach my $pos (@{$mark_positions}) {
			$coordinates->[$pos->[0]][$pos->[1]] = $mark;
		}
	}

lib/Game/TileMap.pm view on Meta::CPAN

__END__

=head1 NAME

Game::TileMap - Representation of tile-based two-dimensional rectangular maps

=head1 SYNOPSIS

	use Game::TileMap;

	# first, create a map legend

	my $legend = Game::TileMap->new_legend;

	$legend
		->add_wall('#')
		->add_void('.')
		->add_terrain('_' => 'pavement')
		->add_object('monster_spawns', 'a' => 'spawn_a')
		->add_object('monster_spawns', 'b' => 'spawn_b')
		->add_object('surroundings', '=' => 'chest')
		;

	# next, create a map

lib/Game/TileMap.pm view on Meta::CPAN

	.__..#a__=
	.__..#__b_
	._________
	.__..#####
	.__.......
	.__.......

	MAP

	my $map = Game::TileMap->new(
		legend => $legend,
		map => $map_str
	);

	# map can be queried to get some info about its contents
	my @monsters = $map->get_all_of_class('monster_spawns');
	my @chests = $map->get_all_of_type('chest');
	my $true = $map->check_within_map(0, 5);
	my $false = $map->check_can_be_accessed(0, 5);

=head1 DESCRIPTION

lib/Game/TileMap.pm view on Meta::CPAN

Game::TileMap is a module which helps you build and store simple
two-dimensional maps of tiles, where each tile contains only one element. Maps
created from this module are generally considered immutable and should only be
used to define a map, not to store its changing state.

Maps can be created out of strings or arrays of arrays and are stored as an
array of array of L<Game::TileMap::Tile>. Some helpful features are in place:

=over

=item * map markers (usually just single characters) are translated into objects specified in the legend

Map characters can't be whitespace (whitespace is removed before processing -
can be used for improved visibility).

Legend objects can't be falsy, but other than that they can be anything
(string, object, reference).

=item * each legend object is assigned to a class, which you can query for later

If you add a class C<surroundings>:

	$legend->add_object('surroundings', '@' => 'trash bin')
	       ->add_object('surroundings', '=' => 'desk')
	       ->add_object('surroundings', 'H' => 'locker')
	       ->add_object('surroundings', 'L' => 'chair');

Then you can easily get information about locations of those tiles on a map:

	my @all_surroundings = $map->get_all_of_class('surroundings');

This array will contains blessed objects of L<Game::TileMap::Tile> class.

lib/Game/TileMap.pm view on Meta::CPAN

This lets you think of a map like you think of a coordinate frame (first quarter).

=item * map array has X coordinates in first dimension and Y coordinates in second dimension

This way you can get more familiar notation:

	$map->coordinates->[3][5]; # actual point at [3;5]

=item * supports multi-character maps

	my $legend = Game::TileMap->new_legend(characters_per_tile => 2);

	$legend
		->add_wall('##')
		->add_void('..')
		->add_terrain('__' => 'pavement')
		->add_terrain('_~' => 'mud')
		->add_terrain('_,' => 'grass')
	;

	my $map_str = <<MAP;
	_, __ __ __ _~
	_, __ ## ## _~
	__ __ ## ## _~
	_, __ ## ## _~
	_, __ __ __ _~
	MAP

=back

=head2 Attributes

=head3 legend

A reference to map legend. Required in constructor.

=head3 coordinates

The constructed map: array of array of L<Game::TileMap::Tile>.

=head3 size_x

Horizontal size of the map.

=head3 size_y

Vertical size of the map.

=head2 Methods

=head3 new_legend

Static method which returns a new instance of L<Game::TileMap::Legend>. Note
that legends are reusable.

=head3 new

Moose-flavored constructor. Possible arguments are:

=over

=item * C<< map => ArrayRef | Str >>

Optional.

Map input that will be passed to L<from_string> or L<from_array>.

=item * C<< legend => InstanceOf ['Game::TileMap::Legend'] >>

Required.

Legend of the map, which describes its contents.

=back

=head3 from_string

	my $map = Game::TileMap->new(legend => $legend);
	$map->from_string($map_str);

Creates a map from a string.

=head3 from_array

	my $map = Game::TileMap->new(legend => $legend);
	$map->from_array($map_aref);

Creates a map from an array.

=head3 to_string

Creates a string from a map.

=head3 to_string_and_mark

lib/Game/TileMap/Legend.pm view on Meta::CPAN

	}

	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;

lib/Game/TileMap/Legend.pm view on Meta::CPAN

The number of characters (horizontal only) than are used to define one tile.

Optional in the constructor. Default: C<1>

=head2 Methods

=head3 new

Moose-flavored constructor. See L</Attributes> for a list of possible arguments.

Note: it may be easier to call L<Game::TileMap/new_legend>.

=head3 add_wall

	$legend = $legend->add_wall($marker, $wall_object);

Defines a marker used to store a wall. You are required to set this.

C<$wall_object> is not required, by default it will be just C<'wall'>. You may
have more than one wall object.

Walls are considered not a part of the map. Think of them as physical obstacles.

=head3 add_void

	$legend = $legend->add_void($marker, $void_object);

Defines a marker used to store a void. You are required to set this.

C<$void_object> is not required, by default it will be just C<'void'>. You may
have more than one void object.

Voids are considered a part of the map, but they are not accessible. Think of
them as chasms which you can see over, but can't walk over.

=head3 add_terrain

	$legend = $legend->add_terrain($marker => $object);

Same as C<< add_object('terrain', $marker => $object) >>.

=head3 add_object

	$legend = $legend->add_object('class', $marker => $object);

Adds a new object with a given class and marker.

=head3 get_class_of_object

	my $class = $legend->get_class_of_object($object);

Returns the object class for a given object defined in the legend.

lib/Game/TileMap/Role/Helpers.pm view on Meta::CPAN

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

use Moo::Role;

requires qw(
	legend
	_guide
);

sub get_all_of_class
{
	my ($self, $class) = @_;

	return @{$self->_guide->{$class}};
}

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

	my $class = $self->legend->get_class_of_object($obj);
	my @all_of_class = $self->get_all_of_class($class);

	return grep { $_->type eq $obj } @all_of_class;
}

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

	return $self->legend->get_class_of_object(ref $obj ? $obj->type : $obj);
}

1;

lib/Game/TileMap/Tile.pm view on Meta::CPAN

has field 'type' => (
	writer => -hidden,

	# isa => Any,
);

sub BUILD
{
	my ($self, $args) = @_;

	my $legend = $args->{legend};
	croak "argument legend is required for Game::TileMap::Tile"
		unless $legend;

	$self->_set_type($self->contents);
	$self->_set_is_void($legend->voids->{$self->type});
	$self->_set_is_wall($legend->walls->{$self->type});
}

1;

__END__

=head1 NAME

Game::TileMap::Tile - Map tile representation

lib/Game/TileMap/Tile.pm view on Meta::CPAN

=head3 is_wall

Is this tile a wall?

=head3 is_void

Is this tile a void?

=head3 type

Type of the tile, as defined in the legend (as C<$object>)

=head2 Methods

=head3 new

Moose-flavored constructor. See L</Attributes> for a list of possible arguments.

In addition, the constructor B<requires> the argument C<legend> - map legend, but
it is only required during building of the object (not stored).

=head3 set_contents

Sets new L</contents> for this tile. Useful if you want to specify this tile
without changing the legend (which may be used across many maps). You can set
contents to be anything, since L</type> is what is used to perform any checks.

t/01-base.t view on Meta::CPAN

use v5.10;
use strict;
use warnings;

use Test::More;
use Game::TileMap;

my $legend = Game::TileMap->new_legend;

$legend
	->add_wall('#')
	->add_void('.')
	->add_terrain('_' => 'pavement')
	->add_object('entrances', '1' => 'door1')
	->add_object('entrances', '2' => 'door2')
	->add_object('entrances', '3' => 'door3')
	->add_object('monster_spawns', 'a' => 'spawn_a')
	->add_object('monster_spawns', 'b' => 'spawn_b')
	->add_object('monster_spawns', 'c' => 'spawn_c')
	->add_object('surroundings', '=' => 'chest')

t/01-base.t view on Meta::CPAN

#_#___b__#
#_######_#
#________#
#...__...#
#...c_...#
#...__...#
#_____x__3
##########
MAP

my $map = Game::TileMap->new(legend => $legend, map => $map_str);

foreach my $item ($map->get_all_of_type('spawn_c')) {
	$item->set_contents('boss_spawn');
}

foreach my $item ($map->get_all_of_class('entrances')) {
	$item->set_contents($item->contents . '_open');
}

subtest 'testing basic map data' => sub {

t/02-multichar.t view on Meta::CPAN

use v5.10;
use strict;
use warnings;

use Test::More;
use Game::TileMap;

my $legend = Game::TileMap->new_legend(characters_per_tile => 2);

$legend
	->add_wall('##')
	->add_void('..')
	->add_terrain('__' => 'pavement')
	->add_object('monster_spawns', 'm1' => 'spawn_1')
	->add_object('monster_spawns', 'm2' => 'spawn_2')
	->add_object('surroundings', '=1' => 'chest_1')
	;

my $map_str = <<MAP;
## ## ## ## ## ## ## ##
__ __ __ __ __ __ __ ##
.. .. .. .. .. .. __ ##
## ## ## ## ## ## __ ##
## =1 __ __ __ ## __ ##
## __ m1 __ __ __ __ ##
## ## ## ## ## ## __ ##
__ __ __ __ m2 __ __ ##
## ## ## ## ## ## ## ##
MAP

my $map = Game::TileMap->new(legend => $legend, map => $map_str);

subtest 'testing basic map data' => sub {
	is $map->size_x, 8, 'size_x ok';
	is $map->size_y, 9, 'size_y ok';

	is scalar @{$map->coordinates}, $map->size_x, 'size_x on coordinates ok';
	is scalar @{$map->coordinates->[0]}, $map->size_y, 'size_y on coordinates[0] ok';

	isa_ok $map->coordinates->[1][4], 'Game::TileMap::Tile';
	is $map->coordinates->[1][4]->x, 1, '1;4 tile pos x ok';

t/03-wall-void.t view on Meta::CPAN

use v5.10;
use strict;
use warnings;

use Test::More;
use Game::TileMap;

my $legend = Game::TileMap->new_legend;

$legend
	->add_wall('#')
	->add_wall('X', 'other wall')
	->add_void('.')
	->add_void('O', 'other void')
	;

my $map_str = <<MAP;
#X
.O
MAP

my $map = Game::TileMap->new(legend => $legend, map => $map_str);

subtest 'testing check_within_map' => sub {
	ok $map->check_within_map(0, 0), '0:0 ok';
	ok $map->check_within_map(1, 0), '1:0 ok';
	ok !$map->check_within_map(0, 1), '0:1 ok';
	ok !$map->check_within_map(1, 1), '1:1 ok';
};

subtest 'testing check_can_be_accessed' => sub {
	ok !$map->check_can_be_accessed(0, 0), '0:0 ok';

( run in 1.327 second using v1.01-cache-2.11-cpan-49f99fa48dc )