| 14 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
| 15 |
|
|
| 16 |
use base qw(Class::Accessor Prefs); |
use base qw(Class::Accessor Prefs); |
| 17 |
__PACKAGE__->mk_accessors(qw(app)); |
__PACKAGE__->mk_accessors(qw(app event)); |
| 18 |
|
|
| 19 |
=head1 NAME |
=head1 NAME |
| 20 |
|
|
| 46 |
#$app->grab_input( SDL_GRAB_QUERY ); |
#$app->grab_input( SDL_GRAB_QUERY ); |
| 47 |
$app->grab_input( SDL_GRAB_OFF ); |
$app->grab_input( SDL_GRAB_OFF ); |
| 48 |
|
|
|
warn "# created SDL::App\n"; |
|
| 49 |
$self->app( $app ); |
$self->app( $app ); |
| 50 |
|
|
| 51 |
|
my $event = SDL::Event->new(); |
| 52 |
|
$self->event( $event ); |
| 53 |
|
|
| 54 |
|
warn "# created SDL::App\n"; |
| 55 |
} |
} |
| 56 |
|
|
| 57 |
my $white = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff ); |
my $white = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff ); |
| 239 |
$app->sync; |
$app->sync; |
| 240 |
} |
} |
| 241 |
|
|
| 242 |
|
=head2 key_pressed |
| 243 |
|
|
| 244 |
|
Check SDL event loop if there are any pending keys |
| 245 |
|
|
| 246 |
|
my $key = $self->key_pressed; |
| 247 |
|
|
| 248 |
|
if ( $self->key_pressed( 1 ) ) { |
| 249 |
|
# just to check other events, don't process |
| 250 |
|
# key |
| 251 |
|
} |
| 252 |
|
|
| 253 |
|
=cut |
| 254 |
|
|
| 255 |
|
my $pending_key; |
| 256 |
|
my $run_for = 2000; |
| 257 |
|
|
| 258 |
|
my $key_down; |
| 259 |
|
|
| 260 |
|
sub key_down { |
| 261 |
|
my $self = shift; |
| 262 |
|
my $key = shift; |
| 263 |
|
warn "key_down($key) = ",$key_down->{$key}, "\n" if $self->debug; |
| 264 |
|
return $key_down->{$key}; |
| 265 |
|
} |
| 266 |
|
|
| 267 |
|
sub key_pressed { |
| 268 |
|
my $self = shift; |
| 269 |
|
|
| 270 |
|
# don't take key, just pull event |
| 271 |
|
my $just_checking = shift || 0; |
| 272 |
|
|
| 273 |
|
my $event = $self->event || confess "no event?"; |
| 274 |
|
|
| 275 |
|
$event->poll || return $pending_key; |
| 276 |
|
|
| 277 |
|
my $type = $event->type(); |
| 278 |
|
|
| 279 |
|
exit if ($type == SDL_QUIT); |
| 280 |
|
|
| 281 |
|
my $k = $pending_key; |
| 282 |
|
|
| 283 |
|
if ($type == SDL_KEYDOWN) { |
| 284 |
|
$k = $event->key_name(); |
| 285 |
|
$key_down->{$k}++; |
| 286 |
|
if ( $k eq 'escape' ) { |
| 287 |
|
$run_for = $self->cli; |
| 288 |
|
warn "will check event loop every $run_for cycles\n"; |
| 289 |
|
$pending_key = '~'; |
| 290 |
|
} else { |
| 291 |
|
warn "SDL_KEYDOWN ($type) = '$k'", $just_checking ? ' fake' : '', "\n"; |
| 292 |
|
$pending_key = $k; |
| 293 |
|
} |
| 294 |
|
} elsif ( $type == SDL_KEYUP ) { |
| 295 |
|
my $up = $event->key_name(); |
| 296 |
|
$key_down->{$up} = 0; |
| 297 |
|
warn "SDL_KEYUP ($type) = '$up'", $just_checking ? ' fake' : '', "\n"; |
| 298 |
|
undef $pending_key; |
| 299 |
|
} |
| 300 |
|
|
| 301 |
|
warn "key_pressed = $pending_key\n" if $pending_key; |
| 302 |
|
|
| 303 |
|
return $pending_key; |
| 304 |
|
} |
| 305 |
|
|
| 306 |
|
=head2 loop |
| 307 |
|
|
| 308 |
|
Implement SDL event loop |
| 309 |
|
|
| 310 |
|
=cut |
| 311 |
|
|
| 312 |
|
sub loop { |
| 313 |
|
my $self = shift; |
| 314 |
|
my $event = SDL::Event->new(); |
| 315 |
|
|
| 316 |
|
|
| 317 |
|
MAIN_LOOP: |
| 318 |
|
while ( 1 ) { |
| 319 |
|
$self->key_pressed( 1 ); |
| 320 |
|
M6502::exec($run_for); |
| 321 |
|
} |
| 322 |
|
} |
| 323 |
|
|
| 324 |
=head1 SEE ALSO |
=head1 SEE ALSO |
| 325 |
|
|
| 326 |
L<Orao> is sample implementation using this module |
L<Orao> is sample implementation using this module |
Parent Directory
| 
Revision Log
| 
Patch