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/;
@ISA = qw/Exporter/;
@EXPORT = qw/KeyDown KeyUp MouseClick/;
@EXPORT = qw/KeyPressed MouseClick/;
@EXPORT_OK = @EXPORT;
%keymap = (
'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 {
foreach my $key (@_) {
@ -30,23 +37,22 @@ sub KeyPress {
}
}
sub KeyDown {
my($key)=@_;
my $key2="$key-down";
LogData(DEVALL, "KeyDown($key)");
KeyPress($key, $key2);
sub get_keymod {
my $mods = shift(@_);
return map { $keymods{$_} } grep { $mods & $_ } (keys %keymods);
}
sub KeyUp {
my($key)=@_;
my $key2="$key-up";
LogData(DEVALL, "KeyUp($key)");
KeyPress($key, $key2);
sub KeyPressed {
my($key, $updown, $mods)=@_;
my @mods = get_keymod($mods);
LogData(DEBUG, "Key %s(%s)", $updown, join(',',@mods, $key));
KeyPress($key, "$key-$updown");
}
sub MouseClick {
my($x, $y, $btn)=@_;
LogData(DEBUG, "MouseClick($x, $y, $btn");
my($x, $y, $btn, $updown, $mods)=@_;
my @mods = get_keymod($mods);
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)) {
if($event->type == SDL_KEYDOWN) {
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) {
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) {
$opt{'Running'} = 0;
}