/t_backcompat/checkkeys.pl

http://github.com/PerlGameDev/SDL · Perl · 85 lines · 61 code · 22 blank · 2 comment · 15 complexity · b4c0cec82572bdcdf974bb1a21b40ac9 MD5 · raw file

  1. #!/usr/bin/env perl
  2. use SDL;
  3. use SDLx::App;
  4. use SDL::Event;
  5. my %options;
  6. die <<USAGE if ( in $ARGV[0], qw/ -? -h --help / );
  7. usage: $0 [-hw] [-fullscreen] [-width 640] [-height 480] [-bpp 24]
  8. USAGE
  9. for ( 0 .. @ARGV - 1 ) {
  10. $options{ $ARGV[$_] } = $ARGV[ $_ + 1 ] || 1;
  11. }
  12. $options{-flags} = SDL_SWSURFACE;
  13. $options{-flags} |= SDL_HWPALETTE if ( $options{-hw} );
  14. $options{-flags} |= SDL_FULLSCREEN if ( $options{-fullscreen} );
  15. $options{-title} = $0;
  16. $options{-width} ||= 640;
  17. $options{-height} ||= 480;
  18. $options{-depth} ||= $options{-bpp} || 24;
  19. my $app = SDLx::App->new(%options);
  20. # SDL::EventState(SDL_KEYUP,SDL_DISABLE);
  21. sub print_modifiers {
  22. $mod = SDL::GetModState();
  23. print " modifiers:",
  24. ( $mod & KMOD_LSHIFT ) ? " LSHIFT" : "",
  25. ( $mod & KMOD_RSHIFT ) ? " RSHIFT" : "",
  26. ( $mod & KMOD_LCTRL ) ? " LCTRL" : "",
  27. ( $mod & KMOD_RCTRL ) ? " RCTRL" : "",
  28. ( $mod & KMOD_LALT ) ? " LALT" : "",
  29. ( $mod & KMOD_RALT ) ? " RALT" : "",
  30. ( $mod & KMOD_LMETA ) ? " LMETA" : "",
  31. ( $mod & KMOD_RMETA ) ? " RMETA" : "",
  32. ( $mod & KMOD_CAPS ) ? " CAPS" : "",
  33. ( $mod & KMOD_NUM ) ? " NUM" : "",
  34. ( $mod & KMOD_MODE ) ? " MODE" : "",
  35. "\n";
  36. }
  37. sub print_key {
  38. my ($e) = @_;
  39. print "pressed " if ( SDL::KeyEventState($e) == SDL_PRESSED );
  40. print "released " if ( SDL::KeyEventState($e) == SDL_RELEASED );
  41. my $sym = SDL::KeyEventSym($e);
  42. if ($sym) {
  43. print SDL::GetKeyName($sym);
  44. } else {
  45. printf "Unknown Key (scancode = %d) ", SDL::KeyEventScanCode($e);
  46. }
  47. }
  48. my $event = SDL::Event->new;
  49. my $done = 0;
  50. $process_keys = sub {
  51. print_key( $_[0] );
  52. print_modifiers();
  53. };
  54. my %events = (
  55. SDL_KEYUP() => $process_keys,
  56. SDL_KEYDOWN() => $process_keys,
  57. SDL_QUIT() => sub { $done = 1; },
  58. );
  59. while ( !$done && $event->wait() ) {
  60. if ( $events{ $event->type() } ) {
  61. &{ $events{ $event->type() } }($$event);
  62. }
  63. }