view release on metacpan or  search on metacpan

lib/Games/Zumbis/Mapa.pm  view on Meta::CPAN

package Games::Zumbis::Mapa;
BEGIN {
  $Games::Zumbis::Mapa::VERSION = '0.05';
}
use Mouse;
use Games::Zumbis;
use Games::Zumbis::L10N;
use XML::Compile::Schema;
use XML::Compile::Util qw(pack_type);
use constant MAP_NS => 'http://perl.org.br/games/zumbis';
my $map_schema = XML::Compile::Schema->new( Games::Zumbis->sharedir->file('mapa.xsd') );
my $map_reader = $map_schema->compile(READER => pack_type(MAP_NS, 'mapa'),
                                      sloppy_integers => 1, sloppy_floats => 1);
use SDL;
use SDL::Color;
use SDL::TTF;
use SDL::Rect;
use SDL::Image;
use SDL::Video;
use Carp ();

SDL::TTF::init;
has arquivo => (is => 'ro', isa => 'Path::Class::File', required => 1);
has dados => (is => 'ro', isa => 'HashRef' );
has colisao => (is => 'ro', isa => 'ArrayRef');
has tileset => (is => 'ro');

my $lh = Games::Zumbis::L10N->get_handle() or die "unable to indentify language";

# translation handles inside renderer was making things too slow
my $texto_mortes = $lh->maketext('Mortes:');
my $texto_segundos = $lh->maketext('segundos');

my $font_p = SDL::TTF::open_font( Games::Zumbis->sharedir->file('dados/AtariSmall.ttf'), 16) or
  die $lh->maketext('Erro carregando a fonte');

my $color = SDL::Color->new(0,0,0);

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

    $args{dados} = $map_reader->($args{arquivo});

    # povoa a matrix de colisoes com 0
    $args{colisao} =
      [ map { [ map { 0 } 0..($args{dados}{width}-1) ] } 0..($args{dados}{height}-1) ];

    for my $object (@{$args{dados}{object}}) {
        my ($x,$y) = split /,/, $object->{position};
        $args{colisao}[$x][$y] = 1 if $object->{collide};
    }

    my $tileset_filename = Games::Zumbis->sharedir->file( $args{dados}{tileset} );
    Carp::croak "tileset '$tileset_filename' não encontrado\n"
        unless -f $tileset_filename;

    $args{tileset} = SDL::Image::load( $tileset_filename );

    return \%args;
};

sub playerstart {
    my ($self) = @_;
    return split(/,/, $self->dados->{playerstart});
};

sub playerstart_px {
    my ($self) = @_;
    my $tilesize = $self->dados->{tilesize};
    return map { $_ * $tilesize } $self->playerstart;
};

sub width {
    my ($self) = @_;
    return $self->dados->{width};
};

sub height {
    my ($self) = @_;
    return $self->dados->{height};
};

sub width_px {
    my ($self) = @_;
    return $self->dados->{width} * $self->dados->{tilesize};