The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

package App::Asciio ;

$|++ ;

use strict;
use warnings;

#------------------------------------------------------------------------------------------------------

sub get_key_modifiers
{
my ($event) = @_ ;

my $key_modifiers = $event->state() ;

my $modifiers = $key_modifiers =~ /control-mask/ ? 'C' :0 ;
$modifiers .= $key_modifiers =~ /mod1-mask/ ? 'A' :0 ;
$modifiers .= $key_modifiers =~ /shift-mask/ ? 'S' :0 ;

return($modifiers) ;
}

#------------------------------------------------------------------------------------------------------

my Readonly $SHORTCUTS = 0 ;
my Readonly $CODE = 1 ;
my Readonly $ARGUMENTS = 2 ;
my Readonly $CONTEXT_MENUE_SUB = 3 ;
my Readonly $CONTEXT_MENUE_ARGUMENTS = 4 ;
my Readonly $NAME= 5 ;
my Readonly $ORIGIN= 6 ;

sub run_actions
{
my ($self, @actions) = @_ ;

my @results ;

for my $action (@actions)
	{
	my @arguments ;
	
	if('ARRAY' eq ref $action)
		{
		($action, @arguments) = @{ $action } ;
		}
		
	my ($modifiers, $action_key) = $action =~ /(...)-(.*)/ ;
	
	if(exists $self->{CURRENT_ACTIONS}{$action})
		{
		if('HASH' eq ref $self->{CURRENT_ACTIONS}{$action})
			{
			my $action_group_name = 
				$self->{CURRENT_ACTIONS}{$action}{GROUP_NAME}  || 'unnamed action group' ;
			
			print "using action handlers group '$action_group_name'" 
				. "[$self->{CURRENT_ACTIONS}{$action}{ORIGIN}].\n" ;
			
			$self->{CURRENT_ACTIONS} = $self->{CURRENT_ACTIONS}{$action} ;
			}
		else
			{
			print "Handling input '$modifiers + $action_key' with action '$self->{CURRENT_ACTIONS}{$action}[$NAME]'"
				. "[$self->{CURRENT_ACTIONS}{$action}[$ORIGIN]].\n" ;
			
			if(defined $self->{CURRENT_ACTIONS}{$action}[$ARGUMENTS])
				{
				push @results,
					[
					$self->{CURRENT_ACTIONS}{$action}[$CODE]->
							(
							$self,
							$self->{CURRENT_ACTIONS}{$action}[$ARGUMENTS],
							@arguments
							) 
					] ;
				}
			else
				{
				push @results,
					[
					$self->{CURRENT_ACTIONS}{$action}[$CODE]->($self, @arguments)
					] ;
				}
			}
		}
	else
		{
		print "no handler for input '$modifiers + $action_key'.\n" ;
		$self->{CURRENT_ACTIONS} = $self->{ACTIONS} ;
		}
	}
	
return @results ;
}

#------------------------------------------------------------------------------------------------------

sub run_actions_by_name
{
my ($self, @actions) = @_ ;
my @results ;

my $current_actions_by_name = $self->{ACTIONS_BY_NAME} ;

for my $action (@actions)
	{
	my @arguments ;
	
	if('ARRAY' eq ref $action)
		{
		($action, @arguments) = @{ $action } ;
		}
		
	if(exists $current_actions_by_name->{$action})
		{
		if('HASH' eq ref $self->{CURRENT_ACTIONS}{$action})
			{
			print "using action handlers group '$action'\n" ;
			$current_actions_by_name = $self->{CURRENT_ACTIONS}{$action} ;
			}
		else
			{
			print "running action '$action'.\n" ;
			
			if(defined $current_actions_by_name->{$action}[$ARGUMENTS])
				{
				push @results,
					[
					$current_actions_by_name->{$action}[$CODE]->
							(
							$self,
							$self->{CURRENT_ACTIONS}{$action}[$ARGUMENTS],
							@arguments
							)
					] ;
				}
			else
				{
				push @results,
					[
					$current_actions_by_name->{$action}[$CODE]->($self, @arguments)
					] ;
				}
			}
		}
	else
		{
		print "no handler for '$action'.\n" ;
		last ;
		}
	}

return @results ;
}

#------------------------------------------------------------------------------------------------------

sub exists_action
{
my ($self, $action) = @_ ;

return exists $self->{CURRENT_ACTIONS}{$action} ;
}

#------------------------------------------------------------------------------------------------------

1 ;