view release on metacpan or  search on metacpan

lib/Games/TMX/Parser.pm  view on Meta::CPAN

use List::MoreUtils qw(natatime);

extends 'Games::TMX::Parser::MapElement';

has [qw(first_gid image tiles width height tile_width tile_height tile_count)] =>
    (is => 'ro', lazy_build => 1);

sub _build_tiles {
    my $self = shift;
    my $first_gid = $self->first_gid;

    # index tiles with properties
    my $prop_tiles = {map {
        my $el = $_;
        my $id = $first_gid + $el->att('id');
        my $properties = {map {
           $_->att('name'), $_->att('value') 
        } $el->first_child('properties')->children};
        my $tile = Games::TMX::Parser::Tile->new
            (id => $id, properties => $properties, tileset => $self);
        ($id => $tile);
    } $self->children('tile')};

    # create a tile object for each tile in the tileset
    # unless it is a tile with properties
    my @tiles;
    my $it = natatime $self->width, 1..$self->tile_count;
    while (my @ids = $it->()) {
        for my $id (@ids) {
            my $gid = $first_gid + $id;
            my $tile = $prop_tiles->{$gid} || 
                Games::TMX::Parser::Tile->new(id => $gid, tileset => $self);
            push @tiles, $tile;
        }
    }
    return [@tiles];
}

sub _build_tile_count {
    my $self = shift;
    return ($self->width      * $self->height     ) /
           ($self->tile_width * $self->tile_height);
}

sub _build_first_gid   { shift->att('firstgid') }
sub _build_tile_width  { shift->att('tilewidth') }
sub _build_tile_height { shift->att('tileheight') }
sub _build_image       { shift->first_child('image')->att('source') }
sub _build_width       { shift->first_child('image')->att('width') }
sub _build_height      { shift->first_child('image')->att('height') }

# ------------------------------------------------------------------------------

package Games::TMX::Parser::Tile;

use Moose;

has id      => (is => 'ro', isa => 'Int', required => 1);
has tileset => (is => 'ro', weak_ref => 1, required => 1);

has properties => (is => 'ro', isa => 'HashRef', default => sub { {} });

sub get_prop {
    my ($self, $name) = @_;
    return $self->properties->{$name};
}

# ------------------------------------------------------------------------------

package Games::TMX::Parser::Layer;

use Moose;
use List::MoreUtils qw(natatime);

has map => (is => 'ro', required => 1, weak_ref => 1, handles => [qw(
    width height tile_width tile_height get_tile
)]);

has rows => (is => 'ro', lazy_build => 1);

extends 'Games::TMX::Parser::MapElement';

sub _build_rows {
    my $self = shift;
    my @rows;
    my $it = natatime $self->width, $self->first_child->children('tile');
    my $y = 0;
    while (my @row = $it->()) {
        my $x = 0;
        push @rows, [map {
            my $el = $_;
            my $id = $el->att('gid');
            my $tile;
            $tile = $self->get_tile($id) if $id;
            Games::TMX::Parser::Cell->new
                (x => $x++, y => $y, tile => $tile, layer => $self)
        } @row];
        $y++;
    }
    return [@rows];
}

sub find_cells_with_property {
    my ($self, $prop) = @_;
    return grep {
        my $cell = $_;
        my $tile = $cell->tile;
        $tile && exists $tile->properties->{$prop};
    } $self->all_cells;
}

sub get_cell {
    my ($self, $col, $row) = @_;
    return $self->rows->[$row]->[$col];
}

sub all_cells { return map { @$_ } @{ shift->rows } }

# ------------------------------------------------------------------------------

package Games::TMX::Parser::Cell;