PageRenderTime 148ms CodeModel.GetById 136ms app.highlight 10ms RepoModel.GetById 1ms app.codeStats 0ms

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