Importing SDLPerl 2.2
[sdlgit/SDL_perl.git] / test / checkkeys.sdlpl
CommitLineData
bfd90409 1#!/usr/bin/env perl
2#
3# checkkeys.pl
4#
5# Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
6#
7# ------------------------------------------------------------------------------
8#
9# This library is free software; you can redistribute it and/or
10# modify it under the terms of the GNU Lesser General Public
11# License as published by the Free Software Foundation; either
12# version 2.1 of the License, or (at your option) any later version.
13#
14# This library is distributed in the hope that it will be useful,
15# but WITHOUT ANY WARRANTY; without even the implied warranty of
16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17# Lesser General Public License for more details.
18#
19# You should have received a copy of the GNU Lesser General Public
20# License along with this library; if not, write to the Free Software
21# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
22#
23# ------------------------------------------------------------------------------
24#
25# Please feel free to send questions, suggestions or improvements to:
26#
27# David J. Goehrig
28# dgoehrig@cpan.org
29#
30
31use SDL;
32use SDL::App;
33use SDL::Event;
34
35my %options;
36
37$options{-flags} = SDL_SWSURFACE;
38$options{-title} = $0;
39$options{-width} ||= 640;
40$options{-height} ||= 480;
41$options{-depth} ||= $options{-bpp} || 24;
42
43my $app = new SDL::App %options;
44
45# SDL::EventState(SDL_KEYUP,SDL_DISABLE);
46
47sub print_modifiers
48{
49 $mod = SDL::GetModState();
50
51 print " modifiers:",
52 ($mod & KMOD_LSHIFT) ? " LSHIFT" : "",
53 ($mod & KMOD_RSHIFT) ? " RSHIFT" : "",
54 ($mod & KMOD_LCTRL) ? " LCTRL" : "",
55 ($mod & KMOD_RCTRL) ? " RCTRL" : "",
56 ($mod & KMOD_LALT) ? " LALT" : "",
57 ($mod & KMOD_RALT) ? " RALT" : "",
58 ($mod & KMOD_LMETA) ? " LMETA" : "",
59 ($mod & KMOD_RMETA) ? " RMETA" : "",
60 ($mod & KMOD_CAPS) ? " CAPS" : "",
61 ($mod & KMOD_NUM) ? " NUM" : "",
62 ($mod & KMOD_MODE) ? " MODE" : "",
63 "\n" ;
64}
65
66sub print_key
67{
68 my ($e) = @_;
69
70 print "pressed " if (SDL::KeyEventState($e) == SDL_PRESSED);
71 print "released " if ( SDL::KeyEventState($e) == SDL_RELEASED);
72
73 my $sym = SDL::KeyEventSym($e);
74
75 if ($sym) {
76 print SDL::GetKeyName($sym);
77 } else {
78 printf "Unknown Key (scancode = %d) ", SDL::KeyEventScanCode($e);
79 }
80
81}
82
83my $event = new SDL::Event;
84
85my $done = 0;
86
87$process_keys = sub {
88 print_key($_[0]);
89 print_modifiers();
90 };
91
92my %events = (
93 SDL_KEYUP() => $process_keys,
94 SDL_KEYDOWN() => $process_keys,
95 SDL_QUIT() => sub { $done = 1; },
96);
97
98while (!$done && $event->wait())
99{
100 if ( $events{$event->type()}) {
101 &{$events{$event->type()}}($$event);
102 }
103};
104