1package SDLx::Controller;
2use strict;
3use warnings;
4use Carp;
5use Time::HiRes;
6use SDL;
7use SDL::Event;
8use SDL::Events;
9use SDL::Video;
10use SDLx::Controller::Interface;
11use SDLx::Controller::State;
12use Scalar::Util 'refaddr';
13
14our $VERSION = 2.548;
15
16# inside out, so this can work as the superclass of another
17# SDL::Surface subclass
18my %_dt;
19my %_min_t;
20my %_current_time;
21my %_stop;
22my %_event;
23my %_event_handlers;
24my %_move_handlers;
25my %_show_handlers;
26my %_sleep_cycle;
27my %_eoq;
28my %_paused;
29
30sub new {
31	my ($self, %args) = @_;
32	if(ref $self) {
33		bless $self, ref $self;
34	}
35	else {
36		my $a;
37		$self = bless \$a, $self;
38	}
39
40	my $ref = refaddr $self;
41
42	$_dt{ $ref }                 = defined $args{dt}    ? $args{dt}    : 0.1;
43	$_min_t{ $ref }              = defined $args{min_t} ? $args{min_t} : 1 / 60;
44#	$_current_time{ $ref }       = $args{current_time} || 0; #no point
45	$_stop{ $ref }               = $args{stop};
46	$_event{ $ref }              = $args{event} || SDL::Event->new();
47	$_event_handlers{ $ref }     = $args{event_handlers} || [];
48	$_move_handlers{ $ref }      = $args{move_handlers}  || [];
49	$_show_handlers{ $ref }      = $args{show_handlers}  || [];
50	$_sleep_cycle{ $ref }		 = $args{delay};
51	$_eoq{$ref} 				 = $args{exit_on_quit} || $args{eoq} || 0;
52#	$_paused{ $ref }             = $args{paused}; #read only
53
54	return $self;
55}
56
57
58sub delay {
59	my $self = shift;
60	my $delay = shift;
61	my $ref = refaddr $self;
62
63	$_sleep_cycle{ $ref }  = $delay if $delay;
64	return $self;
65}
66
67sub DESTROY {
68	my $self = shift;
69	my $ref = refaddr $self;
70
71	delete $_dt{ $ref};
72	delete $_min_t{ $ref};
73	delete $_current_time{ $ref};
74	delete $_stop{ $ref};
75	delete $_event{ $ref};
76	delete $_event_handlers{ $ref};
77	delete $_move_handlers{ $ref};
78	delete $_show_handlers{ $ref};
79	delete $_sleep_cycle { $ref };
80	delete $_eoq{$ref};
81	delete $_paused{$ref};
82}
83
84sub run {
85	my ($self)       = @_;
86	my $ref          = refaddr $self;
87	my $dt           = $_dt{ $ref };
88	my $min_t        = $_min_t{ $ref };
89	my $t            = 0.0;
90
91	#Allows us to do stop and run
92	$_stop{ $ref } = 0;
93
94	$_current_time{ $ref } = Time::HiRes::time;
95	while ( !$_stop{ $ref } ) {
96		$self->_event($ref);
97
98		my $new_time   = Time::HiRes::time;
99		my $delta_time = $new_time - $_current_time{ $ref };
100		next if $delta_time < $min_t;
101		$_current_time{ $ref} = $new_time;
102		my $delta_copy = $delta_time;
103
104		while ( $delta_copy > $dt ) {
105			$self->_move( $ref, 1, $t ); #a full move
106			$delta_copy -= $dt;
107			$t += $dt;
108		}
109		my $step = $delta_copy / $dt;
110		$self->_move( $ref, $step, $t ); #a partial move
111		$t += $dt * $step;
112
113		$self->_show( $ref, $delta_time );
114
115		$dt    = $_dt{ $ref};    #these can change
116		$min_t = $_min_t{ $ref}; #during the cycle
117		SDL::delay( $_sleep_cycle{ $ref } ) if $_sleep_cycle{ $ref };
118	}
119
120}
121
122sub exit_on_quit {
123    my ($self, $value) = @_;
124
125    my $ref = refaddr $self;
126    if (defined $value) {
127        $_eoq{$ref} = $value;
128    }
129
130    return $_eoq{$ref};
131}
132*eoq = \&exit_on_quit;  # alias
133
134sub pause {
135	my ($self, $callback) = @_;
136	my $ref = refaddr $self;
137	$callback ||= sub {1};
138	my $event = SDL::Event->new();
139	$_paused{ $ref} = 1;
140	while(1) {
141		SDL::Events::wait_event($event) or Carp::confess("pause failed waiting for an event");
142		if($callback->($event, $self)) {
143			$_current_time{ $ref} = Time::HiRes::time; #so run doesn't catch up with the time paused
144			last;
145		}
146	}
147	delete $_paused{ $ref};
148}
149
150sub _event {
151	my ($self, $ref) = @_;
152	while ( SDL::Events::poll_event( $_event{ $ref} ) ) {
153		$self->_exit_on_quit( $_event{ $ref}  ) if $_eoq{$ref};
154		foreach my $event_handler ( @{ $_event_handlers{ $ref} } ) {
155			next unless $event_handler;
156			$event_handler->( $_event{ $ref}, $self );
157		}
158	}
159}
160
161sub _move {
162	my ($self, $ref, $move_portion, $t) = @_;
163	foreach my $move_handler ( @{ $_move_handlers{ $ref} } ) {
164		next unless $move_handler;
165		$move_handler->( $move_portion, $self, $t );
166	}
167}
168
169sub _show {
170	my ($self, $ref, $delta_ticks) = @_;
171	foreach my $show_handler ( @{ $_show_handlers{ $ref} } ) {
172		next unless $show_handler;
173		$show_handler->( $delta_ticks, $self );
174	}
175}
176
177sub stop { $_stop{ refaddr $_[0] } = 1 }
178
179sub _add_handler {
180	my ( $arr_ref, $handler ) = @_;
181	push @{$arr_ref}, $handler;
182	return $#{$arr_ref};
183}
184
185sub add_move_handler {
186	my $ref = refaddr $_[0];
187	return _add_handler( $_move_handlers{ $ref}, $_[1] );
188}
189
190sub add_event_handler {
191	my $ref = refaddr $_[0];
192	Carp::confess 'SDLx::App or a Display (SDL::Video::get_video_mode) must be made'
193		unless SDL::Video::get_video_surface();
194	return _add_handler( $_event_handlers{ $ref}, $_[1] );
195}
196
197sub add_show_handler {
198	my $ref = refaddr $_[0];
199	return _add_handler( $_show_handlers{ $ref}, $_[1] );
200}
201
202sub _remove_handler {
203	my ( $arr_ref, $id ) = @_;
204	if ( ref $id ) {
205		($id) = grep {
206					$id eq $arr_ref->[$_]
207				} 0..$#{$arr_ref};
208
209		if ( !defined $id ) {
210			Carp::cluck("$id is not currently a handler of this type");
211			return;
212		}
213	}
214	elsif(!defined $arr_ref->[$id]) {
215		Carp::cluck("$id is not currently a handler of this type");
216		return;
217	}
218	return delete( $arr_ref->[$id] );
219}
220
221sub remove_move_handler {
222	return _remove_handler( $_move_handlers{ refaddr $_[0] }, $_[1] );
223}
224
225sub remove_event_handler {
226	return _remove_handler( $_event_handlers{ refaddr $_[0] }, $_[1] );
227}
228
229sub remove_show_handler {
230	return _remove_handler( $_show_handlers{ refaddr $_[0] }, $_[1] );
231}
232
233sub remove_all_handlers {
234	$_[0]->remove_all_move_handlers;
235	$_[0]->remove_all_event_handlers;
236	$_[0]->remove_all_show_handlers;
237}
238
239sub remove_all_move_handlers {
240	$_move_handlers{ refaddr $_[0] } = [];
241}
242
243sub remove_all_event_handlers {
244	$_event_handlers{ refaddr $_[0] } = [];
245}
246
247sub remove_all_show_handlers {
248	$_show_handlers{ refaddr $_[0] } = [];
249}
250
251sub move_handlers  { $_move_handlers{ refaddr $_[0] } }
252sub event_handlers { $_event_handlers{ refaddr $_[0] } }
253sub show_handlers  { $_show_handlers{ refaddr $_[0] } }
254
255sub dt {
256	my ($self, $arg) = @_;
257	my $ref = refaddr $self;
258	$_dt{ $ref} = $arg if defined $arg;
259
260	$_dt{ $ref};
261}
262
263sub min_t {
264	my ($self, $arg) = @_;
265	my $ref = refaddr $self;
266	$_min_t{ $ref} = $arg if defined $arg;
267
268	$_min_t{ $ref};
269}
270
271sub current_time {
272	my ($self, $arg) = @_;
273	my $ref = refaddr $self;
274	$_current_time{ $ref} = $arg if defined $arg;
275
276	$_current_time{ $ref};
277}
278
279sub paused {
280	$_paused{ refaddr $_[0]};
281}
282
283sub _exit_on_quit {
284   my ($self, $event) = @_;
285
286    $self->stop() if $event->type == SDL_QUIT;
287}
288
2891;
290
291__END__
292
293
294