Ryan
/
PerlRPG
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add key modifier support, mouse control support

This commit is contained in:
Ryan Shepherd 2018-09-25 12:35:34 -04:00
parent 383356f361
commit b3b7109bab
2 changed files with 36 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
PerlRPG/Controls.pm
View File

@ -14,13 +14,20 @@ use PerlRPG::Script;
use vars qw/$app @ISA @EXPORT @EXPORT_OK %keymap/; use vars qw/$app @ISA @EXPORT @EXPORT_OK %keymap/;
@ISA = qw/Exporter/; @ISA = qw/Exporter/;
@EXPORT = qw/KeyDown KeyUp MouseClick/; @EXPORT = qw/KeyPressed MouseClick/;
@EXPORT_OK = @EXPORT; @EXPORT_OK = @EXPORT;
%keymap = ( %keymap = (
'space-down' => \&PerlRPG::Script::SkipText, 'space-down' => \&PerlRPG::Script::SkipText,
); );
my %keymods=(
SDL::Event::KMOD_CTRL => "ctrl",
SDL::Event::KMOD_SHIFT => "shift",
SDL::Event::KMOD_ALT => "alt",
SDL::Event::KMOD_META => "meta",
);
sub KeyPress { sub KeyPress {
foreach my $key (@_) { foreach my $key (@_) {
@ -30,23 +37,22 @@ sub KeyPress {
} }
} }
sub KeyDown { sub get_keymod {
my($key)=@_; my $mods = shift(@_);
my $key2="$key-down"; return map { $keymods{$_} } grep { $mods & $_ } (keys %keymods);
LogData(DEVALL, "KeyDown($key)");
KeyPress($key, $key2);
} }
sub KeyUp { sub KeyPressed {
my($key)=@_; my($key, $updown, $mods)=@_;
my $key2="$key-up"; my @mods = get_keymod($mods);
LogData(DEVALL, "KeyUp($key)");
KeyPress($key, $key2); LogData(DEBUG, "Key %s(%s)", $updown, join(',',@mods, $key));
KeyPress($key, "$key-$updown");
} }
sub MouseClick { sub MouseClick {
my($x, $y, $btn)=@_; my($x, $y, $btn, $updown, $mods)=@_;
my @mods = get_keymod($mods);
LogData(DEBUG, "MouseClick($x, $y, $btn");
LogData(DEBUG, "MouseClick %s %i,%i (%s)", $updown, $x, $y, join(',',@mods, $btn));
} }

18
PerlRPG/Game.pm
View File

@ -67,10 +67,24 @@ sub EventDispatcher {
while(SDL::Events::poll_event($event)) { while(SDL::Events::poll_event($event)) {
if($event->type == SDL_KEYDOWN) { if($event->type == SDL_KEYDOWN) {
my $key = SDL::Events::get_key_name($event->key_sym); my $key = SDL::Events::get_key_name($event->key_sym);
KeyDown($key); KeyPressed($key, 'down', SDL::Events::get_mod_state());
} elsif($event->type == SDL_KEYUP) { } elsif($event->type == SDL_KEYUP) {
my $key = SDL::Events::get_key_name($event->key_sym); my $key = SDL::Events::get_key_name($event->key_sym);
KeyUp($key); KeyPressed($key, 'up', SDL::Events::get_mod_state());
} elsif($event->type == SDL_MOUSEBUTTONDOWN) {
MouseClick( $event->button_x,
$event->button_y,
$event->button_button,
'down',
SDL::Events::get_mod_state()
);
} elsif($event->type == SDL_MOUSEBUTTONUP) {
MouseClick( $event->button_x,
$event->button_y,
$event->button_button,
'up',
SDL::Events::get_mod_state()
);
} elsif($event->type == SDL_QUIT) { } elsif($event->type == SDL_QUIT) {
$opt{'Running'} = 0; $opt{'Running'} = 0;
} }