Source

Kephra / lib / Kephra / API / KeyMap.pm

Full commit
use strict;
use warnings;
use Wx;
use Kephra::API;

package Kephra::API::KeyMap;

my %definition;
my %code;
my %mod_key_value = ( shift => 1000, ctrl => 2000, alt  => 4000);
my %key_value = (
	left  => &Wx::WXK_LEFT,      right => &Wx::WXK_RIGHT,
	up    => &Wx::WXK_UP,         down => &Wx::WXK_DOWN,
	pageup=> &Wx::WXK_PAGEUP, pagedown => &Wx::WXK_PAGEDOWN,
	home  => &Wx::WXK_HOME,        end => &Wx::WXK_END,
	delete => &Wx::WXK_DELETE,  insert => &Wx::WXK_INSERT,
	back  => &Wx::WXK_BACK,        tab => &Wx::WXK_TAB,
	esc   => &Wx::WXK_ESCAPE,    
	enter => &Wx::WXK_RETURN,    space => &Wx::WXK_SPACE,
	F1 => &Wx::WXK_F1, F2 => &Wx::WXK_F2,  F3 => &Wx::WXK_F3,  F4 => &Wx::WXK_F4,
	F5 => &Wx::WXK_F5, F6 => &Wx::WXK_F6,  F7 => &Wx::WXK_F7,  F8 => &Wx::WXK_F8,
	F9 => &Wx::WXK_F9,F10 => &Wx::WXK_F10,F11 => &Wx::WXK_F11,F12 => &Wx::WXK_F12,
	pound => 35, plus => 43, minus => 45, sharp => 47, tilde => 92, 
	num_left  => &Wx::WXK_NUMPAD_LEFT,  num_right=> &Wx::WXK_NUMPAD_RIGHT,
	num_up    => &Wx::WXK_NUMPAD_UP,    num_down => &Wx::WXK_NUMPAD_DOWN,
	num_space => &Wx::WXK_NUMPAD_SPACE, num_tab  => &Wx::WXK_NUMPAD_TAB,
	num_enter => &Wx::WXK_NUMPAD_ENTER, num_F1   => &Wx::WXK_NUMPAD_F1,
);
my $main_map = 'editor';

sub apply {}
sub build {}
sub copy {}
sub overlay {}
sub register_map {
}

sub register_keys {
	my ($keys, $map) = @_;
	return Kephra::Log::warning("got no hashref") unless ref $keys eq ref {};
	$map = $main_map unless defined $map;
	for my $cmd (keys %$keys) {
		$definition{$map}{ $cmd } = $keys->{$cmd};
		my $code = keycode_from_definition( $keys->{$cmd} );
		unless (exists $code{$map}{ $code }) { $code{$map}{ $code } = $cmd }
		else {
			Kephra::Log::warning("$cmd tried to register the already taken keycode $code");
		}
	}
}

sub keycode_is_registered {
	my ($code, $map) = @_;
	Kephra::Log::warning('got no key code') unless $code;
	$map = $main_map unless defined $map;
	return 1 if defined $code{$map}{$code} and $code{$map}{$code}
}

sub cmd_from_keycode {
	my ($code, $map) = @_;
	Kephra::Log::warning('got no key code') unless $code;
	$map = $main_map unless defined $map;
	$code{$map}{$code};
}

sub keycode_from_definition {
	my $def = shift;
	$def =~ tr/ 	//d;
	Kephra::Log::warning('got no key definition') unless $def;

	my @key = split '\+', $def;           # only + can combine key in definition
	my $code = length($key[-1]) == 1 ? ord uc $key[-1] : $key_value{ $key[-1] };
	Kephra::Log::warning('don\'t know this key '.$key[-1]) unless $code;

	$code += $mod_key_value{ shift(@key) } while @key > 1;
	Kephra::Log::warning("got unknown key definition $def") unless $code;
	return $code;
}

sub keycode_from_event {
	my $event = shift;
	Kephra::Log::warning ("got no event, but $event") unless ref $event and $event->isa('Wx::Event');
	my $code = $event->GetKeyCode;
	$code += $mod_key_value{'shift'} if $event->ShiftDown;
	$code += $mod_key_value{'ctrl'} if $event->ControlDown;
	$code += $mod_key_value{'alt'} if $event->AltDown;
	return $code;
}

sub react_on_event {
	my ($event, $map) = @_;
	Kephra::Log::warning ("got no event, but $event") unless ref $event and $event->isa('Wx::Event');
	$map = $main_map unless defined $map;
	my $key = keycode_from_event($event);
	Kephra::API::log("pressed key $key inside the ".(caller)[0]);
	if (keycode_is_registered($key)){
			my $cmd = cmd_from_code($key);
			Kephra::API::log("run command: $cmd");
			Kephra::API::Command::run( $cmd );
	}
	else {$event->Skip}
}

1;