245 |
=cut |
=cut |
246 |
|
|
247 |
my $pending_key; |
my $pending_key; |
248 |
|
my $key_active; |
249 |
my $run_for = 2000; |
my $run_for = 2000; |
250 |
|
|
251 |
sub key_pressed { |
sub key_pressed { |
263 |
if ( $state ) { |
if ( $state ) { |
264 |
$pending_key = $key; |
$pending_key = $key; |
265 |
$self->key_down( $key ); |
$self->key_down( $key ); |
266 |
|
$key_active->{$key} = 1; |
267 |
} else { |
} else { |
268 |
undef $pending_key; |
undef $pending_key; |
269 |
$self->key_up( $key ); |
$self->key_up( $key ); |
270 |
|
$key_active->{$key} = 0; |
271 |
} |
} |
272 |
} |
} |
273 |
return $pending_key; |
return $pending_key; |
289 |
warn "SDL_KEYDOWN ($type) = '$k'", $just_checking ? ' fake' : '', "\n"; |
warn "SDL_KEYDOWN ($type) = '$k'", $just_checking ? ' fake' : '', "\n"; |
290 |
$pending_key = $k; |
$pending_key = $k; |
291 |
$self->key_down( $k ); |
$self->key_down( $k ); |
292 |
|
$key_active->{$k} = 1; |
293 |
$self->record_session('key_pressed', { $k => 1 }); |
$self->record_session('key_pressed', { $k => 1 }); |
294 |
} |
} |
295 |
} elsif ( $type == SDL_KEYUP ) { |
} elsif ( $type == SDL_KEYUP ) { |
296 |
my $up = $event->key_name(); |
my $up = $event->key_name(); |
297 |
warn "SDL_KEYUP ($type) = '$up'", $just_checking ? ' fake' : '', "\n"; |
warn "SDL_KEYUP ($type) = '$up'", $just_checking ? ' fake' : '', "\n"; |
298 |
$self->key_up( $up ); |
$self->key_up( $up ); |
299 |
|
$key_active->{$up} = 0; |
300 |
$self->record_session('key_pressed', { $up => 0 }); |
$self->record_session('key_pressed', { $up => 0 }); |
301 |
undef $pending_key; |
undef $pending_key; |
302 |
} |
} |
306 |
return $pending_key; |
return $pending_key; |
307 |
} |
} |
308 |
|
|
309 |
|
=head2 key_active |
310 |
|
|
311 |
|
Is key currently pressed on keyboard or in session? |
312 |
|
|
313 |
|
$self->key_active( 'left shift', 'right shift', 'a' ); |
314 |
|
|
315 |
|
=cut |
316 |
|
|
317 |
|
sub key_active { |
318 |
|
my $self = shift; |
319 |
|
my @keys = @_; |
320 |
|
confess "Regexp is no longer supported" if ref($_[0]) eq 'Regexp'; |
321 |
|
|
322 |
|
my $active = 0; |
323 |
|
foreach my $key ( @keys ) { |
324 |
|
$active++ if $key_active->{$key}; |
325 |
|
} |
326 |
|
|
327 |
|
warn "## key_active(",dump(@keys),") = $active\n" if $active; |
328 |
|
return $active; |
329 |
|
} |
330 |
|
|
331 |
=head2 loop |
=head2 loop |
332 |
|
|
333 |
Implement CPU run for C<$run_run> cycles inside SDL event loop |
Implement CPU run for C<$run_run> cycles inside SDL event loop |