#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Tickit::Test;
my $rootwin = mk_window;
my $win = $rootwin->make_sub( 3, 10, 4, 20 );
$win->focus( 0, 0 );
flush_tickit;
my $keyev;
my @key_events;
$win->set_on_key( sub {
( undef, $keyev ) = @_;
push @key_events, [ $keyev->type => $keyev->str ];
return 1;
} );
# Simple key events
{
presskey( text => "A" );
is_deeply( \@key_events, [ [ text => "A" ] ], 'on_key A' );
ok( !$keyev->mod_is_shift, 'A key is not shift' );
ok( !$keyev->mod_is_ctrl, 'A key is not ctrl' );
ok( !$keyev->mod_is_alt, 'A key is not alt' );
undef @key_events;
presskey( key => "C-a", 4 );
is_deeply( \@key_events, [ [ key => "C-a" ] ], 'on_key C-a' );
ok( !$keyev->mod_is_shift, 'C-a key is not shift' );
ok( $keyev->mod_is_ctrl, 'C-a key is ctrl' );
ok( !$keyev->mod_is_alt, 'C-a key is not alt' );
}
my @mouse_events;
$win->set_on_mouse( sub {
my ( $self, $ev ) = @_;
push @mouse_events, [ $ev->type => $ev->button, $ev->line, $ev->col ];
return 1;
} );
# Simple mouse events
{
undef @mouse_events;
pressmouse( press => 1, 5, 15 );
is_deeply( \@mouse_events, [ [ press => 1, 2, 5 ] ], 'on_mouse abs@15,5' );
undef @mouse_events;
pressmouse( press => 1, 1, 2 );
is_deeply( \@mouse_events, [], 'no event for mouse abs@2,1' );
}
# Event passing to subwindows
{
my $subwin = $win->make_sub( 2, 2, 1, 10 );
$subwin->focus( 0, 0 );
flush_tickit;
my @subkey_events;
my @submouse_events;
my $subret = 1;
$subwin->set_on_key( sub {
my ( $self, $ev ) = @_;
push @subkey_events, [ $ev->type => $ev->str ];
return $subret;
} );
$subwin->set_on_mouse( sub {
my ( $self, $ev ) = @_;
push @submouse_events, [ $ev->type => $ev->button, $ev->line, $ev->col ];
return $subret;
} );
undef @key_events;
presskey( text => "B" );
is_deeply( \@subkey_events, [ [ text => "B" ] ], 'on_key B on subwin' );
is_deeply( \@key_events, [ ], 'on_key B on win' );
undef @mouse_events;
pressmouse( press => 1, 5, 15 );
is_deeply( \@submouse_events, [ [ press => 1, 0, 3 ] ], 'on_mouse abs@15,5 on subwin' );
is_deeply( \@mouse_events, [ ], 'on_mouse abs@15,5 on win' );
$subret = 0;
undef @key_events;
undef @subkey_events;
presskey( text => "C" );
is_deeply( \@subkey_events, [ [ text => "C" ] ], 'on_key C on subwin' );
is_deeply( \@key_events, [ [ text => "C" ] ], 'on_key C on win' );
undef @mouse_events;
undef @submouse_events;
pressmouse( press => 1, 5, 15 );
is_deeply( \@submouse_events, [ [ press => 1, 0, 3 ] ], 'on_mouse abs@15,5 on subwin' );
is_deeply( \@mouse_events, [ [ press => 1, 2, 5 ] ], 'on_mouse abs@15,5 on win' );
my $otherwin = $rootwin->make_sub( 10, 10, 4, 20 );
flush_tickit;
my @handlers;
$win->set_on_key ( sub { push @handlers, "win"; return 0 } );
$subwin->set_on_key ( sub { push @handlers, "subwin"; return 0 } );
$otherwin->set_on_key( sub { push @handlers, "otherwin"; return 0 } );
presskey( text => "D" );
is_deeply( \@handlers, [qw( subwin win otherwin )], 'on_key D propagates to otherwin after win' );
$subwin->hide;
undef @handlers;
presskey( text => "E" );
is_deeply( \@handlers, [qw( win otherwin )], 'hidden windows do not receive input events' );
$subwin->close;
flush_tickit;
}
# Windows created in input event handlers don't receive events
{
my $childwin;
my $childmouse;
$win->set_on_mouse( sub {
return if $childwin;
$childwin = $win->make_sub( 0, 0, 2, 2 );
$childwin->set_on_mouse( sub { $childmouse++ } );
} );
pressmouse( press => 1, 3, 10 );
ok( defined $childwin, '$childwin created' );
ok( !$childmouse, '$childwin has not yet received mouse event' );
flush_tickit;
pressmouse( press => 1, 3, 10 );
is( $childmouse, 1, '$childwin has now received a mouse event after flush' );
$childwin->close;
flush_tickit;
}
{
my $sibwin;
my $sibmouse;
$win->set_on_mouse( sub {
return if $sibwin;
$sibwin = $win->make_float( 0, 0, 2, 2 );
$sibwin->set_on_mouse( sub { $sibmouse++ });
} );
pressmouse( press => 1, 3, 10 );
ok( defined $sibwin, '$sibwin created' );
ok( !$sibmouse, '$sibwin has not yet received mouse event' );
flush_tickit;
pressmouse( press => 1, 3, 10 );
is( $sibmouse, 1, '$sibwin has now received a mouse event after flush' );
$sibwin->close;
flush_tickit;
}
done_testing;