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