59 lines
1.1 KiB
Perl
59 lines
1.1 KiB
Perl
package PerlRPG::Game;
|
|
use strict;
|
|
require Exporter;
|
|
use SDL;
|
|
use SDL::Event;
|
|
use SDLx::App;
|
|
use SDLx::Sprite;
|
|
use SDLx::Sprite::Animated;
|
|
use PerlRPG::Game;
|
|
use PerlRPG::Console;
|
|
use PerlRPG::Assets;
|
|
use PerlRPG::Drawing;
|
|
use PerlRPG::Script;
|
|
use vars qw/$app @ISA @EXPORT @EXPORT_OK %keymap/;
|
|
|
|
@ISA = qw/Exporter/;
|
|
@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 (@_) {
|
|
if(exists($keymap{$key})) {
|
|
$keymap{$key}->($key);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub get_keymod {
|
|
my $mods = shift(@_);
|
|
return map { $keymods{$_} } grep { $mods & $_ } (keys %keymods);
|
|
}
|
|
|
|
sub KeyPressed {
|
|
my($key, $updown, $mods)=@_;
|
|
my @mods = get_keymod($mods);
|
|
|
|
LogData(DEVALL, "Key %s(%s)", $updown, join(',',@mods, $key));
|
|
KeyPress($key, "$key-$updown");
|
|
}
|
|
|
|
sub MouseClick {
|
|
my($x, $y, $btn, $updown, $mods)=@_;
|
|
my @mods = get_keymod($mods);
|
|
|
|
LogData(DEVALL, "MouseClick %s %i,%i (%s)", $updown, $x, $y, join(',',@mods, $btn));
|
|
}
|