/t_backcompat/MoP/lib/SDL/Tutorial/MoP/Model/Map.pm

  1package SDL::Tutorial::MoP::Model::Map;
  2
  3use strict;
  4use warnings;
  5
  6use base 'SDL::Tutorial::MoP::Base';
  7
  8use File::ShareDir qw(module_file);
  9use Carp;
 10
 11use SDL;
 12use SDL::Video;
 13use SDL::Surface;
 14use SDL::Tutorial::MoP::Models;
 15
 16#BEGIN {
 17#    use Exporter ();
 18#    use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 19#    $VERSION     = '0.01';
 20#    @ISA         = qw(Exporter);
 21#    #Give a hoot don't pollute, do not export more than needed by default
 22#    @EXPORT      = qw();
 23#    @EXPORT_OK   = qw(draw_map);
 24#    %EXPORT_TAGS = ();
 25#}
 26
 27my $tile_size = 10;
 28
 29my $path = module_file( 'SDL::Tutorial::MoP', 'data/tiles.bmp' );
 30my $tiles = SDL::Video::load_BMP($path);
 31Carp::confess 'Error: ' . SDL::get_error() if ( !$tiles );
 32
 33my $map_surface; # the image(s) of the current map are here
 34my $is_up_to_date = 0;
 35
 36my ( $x, $y, $w, $h ) = ( 0, 0, 0, 0 );
 37
 38sub new {
 39	my ( $class, %params ) = (@_);
 40
 41	my $self = $class->SUPER::new(%params);
 42
 43	$self->evt_manager->reg_listener($self);
 44	$self->init(%params);
 45
 46	return $self;
 47}
 48
 49sub init {
 50	my ( $self, %params ) = @_;
 51
 52	$self->load_map() || Carp::cluck("load_map() failed");
 53	$self->x(0);
 54	$self->y(0);
 55	$self->w( $self->surface()->w() );
 56	$self->h( $self->surface()->h() );
 57
 58	$self->{map} ||= [];
 59}
 60
 61sub notify {
 62	my ( $self, $event ) = (@_);
 63
 64	print Carp::cluck( sprintf( "Notify '%s'in Map", $event->{name} ) )
 65		if $self->{EDEBUG};
 66
 67	my %event_action = (
 68
 69		#        'MapMoveRequest' => sub {
 70		#            $self->move_map($event->{direction}) if $map_rect;
 71		#            $self->evt_manager->post({ name => 'MapMove' });
 72		#        },
 73	);
 74
 75	my $action = $event_action{ $event->{name} };
 76
 77	if ( defined $action ) {
 78		print "Event $event->{name}\n" if $self->{GDEBUG};
 79		$action->();
 80	}
 81}
 82
 83# loads the bitmap file into $self->surface and also the tile-definitions into @map
 84sub load_map {
 85	my $self     = shift;
 86	my $_path    = module_file( 'SDL::Tutorial::MoP', 'data/main.bmp' );
 87	my $_surface = SDL::Video::load_BMP($_path);
 88
 89	#my $_surface = SDL::IMG_Load($_path);
 90
 91	if ($_surface) {
 92		$self->surface($_surface);
 93		$is_up_to_date = 0;
 94		$_surface      = undef;
 95		return 1;
 96	} else {
 97		Carp::cluck("Could not load bitmap $_path.");
 98		return -1;
 99	}
100}
101
102sub get_tile {
103	my $self = shift;
104	my $x    = shift;
105	my $y    = shift;
106
107	#	return $self->get_tile_by_index(${$map[$y + $map_center[1]]}[$x + $map_center[0]] ? 5 : 6);
108}
109
110sub get_tile_by_index {
111	my $self = shift;
112	my $index = shift || 0;
113
114	Carp::cluck 'Unable to load tiles ' . SDL::get_error() if ( !$tiles );
115
116	my $x = ( $index * $tile_size ) % $tiles->w;
117	my $y = int( ( $index * $tile_size ) / $tiles->w ) * $tile_size;
118
119	return SDL::Rect->new( $x, $y, $tile_size, $tile_size );
120}
121
122sub tile_size {
123	my $self = shift;
124	$tile_size = shift || return $tile_size;
125}
126
127sub tiles {
128	my $self = shift;
129	$tiles = shift || return $tiles;
130}
131
132sub surface {
133	my $self = shift;
134	$map_surface = shift || return $map_surface;
135}
136
137sub x {
138	my $self = shift;
139	my $_x   = shift;
140
141	if ( defined $_x ) {
142		$x = $_x;
143		$self->is_up_to_date(0);
144		return $self;
145	}
146
147	return $x;
148}
149
150sub y {
151	my $self = shift;
152	my $_y   = shift;
153
154	if ( defined $_y ) {
155		$y = $_y;
156		$self->is_up_to_date(0);
157		return $self;
158	}
159
160	return $y;
161}
162
163sub w {
164	my $self = shift;
165	my $_w   = shift;
166
167	if ( defined $_w ) {
168		$w = $_w;
169		$self->is_up_to_date(0);
170		return $self;
171	}
172
173	return $w;
174}
175
176sub h {
177	my $self = shift;
178	my $_h   = shift;
179
180	if ( defined $_h ) {
181		$h = $_h;
182		$self->is_up_to_date(0);
183		return $self;
184	}
185
186	return $h;
187}
188
189sub is_up_to_date {
190	my $self = shift;
191	$is_up_to_date = shift || return $is_up_to_date;
192}
193
1941;