PageRenderTime 60ms CodeModel.GetById 32ms RepoModel.GetById 1ms app.codeStats 0ms

/lib/Games/Zumbis/Mapa.pm

https://github.com/FROGGS/Zumbis
Perl | 137 lines | 109 code | 25 blank | 3 comment | 5 complexity | fd273c731840f244a66902f878ce5ba6 MD5 | raw file
  1. package Games::Zumbis::Mapa;
  2. use Mouse;
  3. use Games::Zumbis;
  4. use XML::Compile::Schema;
  5. use XML::Compile::Util qw(pack_type);
  6. use constant MAP_NS => 'http://perl.org.br/games/zumbis';
  7. my $map_schema = XML::Compile::Schema->new( Games::Zumbis->sharedir->file('mapa.xsd') );
  8. my $map_reader = $map_schema->compile(READER => pack_type(MAP_NS, 'mapa'),
  9. sloppy_integers => 1, sloppy_floats => 1);
  10. use SDL;
  11. use SDL::Color;
  12. use SDL::TTF;
  13. use SDL::Rect;
  14. use SDL::Image;
  15. use SDL::Video;
  16. use Carp ();
  17. SDL::TTF::init;
  18. has arquivo => (is => 'ro', isa => 'Path::Class::File', required => 1);
  19. has dados => (is => 'ro', isa => 'HashRef' );
  20. has colisao => (is => 'ro', isa => 'ArrayRef');
  21. has tileset => (is => 'ro');
  22. my $font_p = SDL::TTF::open_font( Games::Zumbis->sharedir->file('dados/AtariSmall.ttf'), 16) or
  23. die 'Erro carregando a fonte';
  24. my $color = SDL::Color->new(0,0,0);
  25. sub BUILDARGS {
  26. my ($self, %args) = @_;
  27. $args{dados} = $map_reader->($args{arquivo});
  28. # povoa a matrix de colisoes com 0
  29. $args{colisao} =
  30. [ map { [ map { 0 } 0..($args{dados}{width}-1) ] } 0..($args{dados}{height}-1) ];
  31. for my $object (@{$args{dados}{object}}) {
  32. my ($x,$y) = split /,/, $object->{position};
  33. $args{colisao}[$x][$y] = 1 if $object->{collide};
  34. }
  35. my $tileset_filename = Games::Zumbis->sharedir->file( $args{dados}{tileset} );
  36. Carp::croak "tileset '$tileset_filename' não encontrado\n"
  37. unless -f $tileset_filename;
  38. $args{tileset} = SDL::Image::load( $tileset_filename );
  39. return \%args;
  40. };
  41. sub playerstart {
  42. my ($self) = @_;
  43. return split(/,/, $self->dados->{playerstart});
  44. };
  45. sub playerstart_px {
  46. my ($self) = @_;
  47. my $tilesize = $self->dados->{tilesize};
  48. return map { $_ * $tilesize } $self->playerstart;
  49. };
  50. sub width {
  51. my ($self) = @_;
  52. return $self->dados->{width};
  53. };
  54. sub height {
  55. my ($self) = @_;
  56. return $self->dados->{height};
  57. };
  58. sub width_px {
  59. my ($self) = @_;
  60. return $self->dados->{width} * $self->dados->{tilesize};
  61. };
  62. sub height_px {
  63. my ($self) = @_;
  64. return $self->dados->{height} * $self->dados->{tilesize};
  65. };
  66. sub tilesize {
  67. my ($self) = @_;
  68. return $self->dados->{tilesize};
  69. }
  70. sub render {
  71. my ($self, $surface, $tempo, $score) = @_;
  72. my $tilesize = $self->dados->{tilesize};
  73. my $tileset = $self->tileset;
  74. # renderizar o background;
  75. my $back_rect = SDL::Rect->new((map {$_ * $tilesize } split /,/, $self->dados->{background}),
  76. $tilesize, $tilesize);
  77. for my $x (0..($self->dados->{width}-1)) {
  78. for my $y (0..($self->dados->{height}-1)) {
  79. my $rect = SDL::Rect->new($x*$tilesize, $y*$tilesize,
  80. $tilesize, $tilesize);
  81. SDL::Video::blit_surface( $tileset, $back_rect,
  82. $surface, $rect );
  83. }
  84. }
  85. # renderizar os objetos;
  86. for my $object (@{$self->dados->{object}}) {
  87. my $src_rect = SDL::Rect->new((map { $_ * $tilesize } split /,/, $object->{tile}),
  88. $tilesize, $tilesize);
  89. my $dst_rect = SDL::Rect->new((map { $_ * $tilesize } split /,/, $object->{position}),
  90. $tilesize, $tilesize);
  91. SDL::Video::blit_surface( $tileset, $src_rect,
  92. $surface, $dst_rect );
  93. }
  94. my $timer =
  95. SDL::TTF::render_text_blended
  96. ($font_p, "Mortes: $score. $tempo segundos", $color)
  97. or die 'TTF render error: ' . SDL::get_error();
  98. my $timer_w = $timer->w;
  99. my $timer_h = $timer->h;
  100. my $timer_srcrect = SDL::Rect->new(0,0,$timer_w,$timer_h);
  101. my $dstrect = SDL::Rect->new(40,$surface->h - $timer_h - 30,$timer_w,$timer_h);
  102. SDL::Video::blit_surface($timer, $timer_srcrect, $surface, $dstrect);
  103. };
  104. sub next_spawnpoint_px {
  105. my ($self) = @_;
  106. my $tilesize = $self->dados->{tilesize};
  107. my $sp_count = scalar @{$self->dados->{zombie}};
  108. my $sp_num = int(rand($sp_count - 1)+0.5);
  109. return map { $_ * $tilesize } split /,/, $self->dados->{zombie}[$sp_num]{posicao};
  110. }
  111. __PACKAGE__->meta->make_immutable();
  112. 1;