The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use Test::Identity;
use Test::Refcount;

use Tickit::Test;

# Since we need real Windows in the widgets, it's easier just to use an HBox
# as a container. However, since HBox is no longer in core, we'll have to skip
# this test if it isn't available
BEGIN {
   eval { require Tickit::Widget::HBox } or
      plan skip_all => "Tickit::Widget::HBox is not available";
}

my ( $term, $win ) = mk_term_and_window;

my @f_widgets = map { my $w = TestWidget->new; $w->{CAN_FOCUS} = 1; $w } 0 .. 2;
my @n_widgets = map { TestWidget->new } 0 .. 3;

# first/after/before/last on a single container
{
   my $container = TestContainer->new;
   $container->set_window( $win );

   $container->add( $_ ) for $n_widgets[0], $f_widgets[0], $n_widgets[1], $f_widgets[1];

   is( $container->pen->getattr( 'fg' ), undef, '$container pen fg is undef before focus child' );

   $container->focus_next( first => undef );
   ok( $f_widgets[0]->window->is_focused, '$f_widgets[0] has focus after "first" linear' );

   is( $container->pen->getattr( 'fg' ), 1, '$container pen fg is 1 after focus child' );

   $container->focus_next( after => $f_widgets[0] );
   ok( $f_widgets[1]->window->is_focused, '$f_widgets[1] has focus after "after" linear' );

   $container->focus_next( before => $f_widgets[1] );
   ok( $f_widgets[0]->window->is_focused, '$f_widgets[0] has focus after "before" linear' );

   $container->focus_next( last => undef );
   ok( $f_widgets[1]->window->is_focused, '$f_widgets[1] has focus after "last" linear' );

   # Wrap-around at the top level
   $container->focus_next( after => $f_widgets[1] );
   ok( $f_widgets[0]->window->is_focused, '$f_widgets[0] has focus after "after" linear wraparound' );

   $container->focus_next( before => $f_widgets[0] );
   ok( $f_widgets[1]->window->is_focused, '$f_widgets[1] has focus after "before" linear wraparound' );

   $container->set_window( undef );
}

# Tree search
{
   my $tree1 = Tickit::Widget::HBox->new;
   $tree1->add( $_ ) for $f_widgets[0], $n_widgets[0];

   my $tree2 = Tickit::Widget::HBox->new;
   $tree2->add( $_ ) for $f_widgets[1], $n_widgets[1];

   my $root = Tickit::Widget::HBox->new;
   $root->add( $_ ) for $tree1, $tree2;

   $root->set_window( $win );

   $root->focus_next( first => undef );
   ok( $f_widgets[0]->window->is_focused, '$f_widgets[0] has focus after "first" tree' );

   $tree1->focus_next( after => $f_widgets[0] );
   ok( $f_widgets[1]->window->is_focused, '$f_widgets[1] has focus after "after" tree' );

   $tree2->focus_next( before => $f_widgets[1] );
   ok( $f_widgets[0]->window->is_focused, '$f_widgets[0] has focus after "before" tree' );

   $root->focus_next( last => undef );
   ok( $f_widgets[1]->window->is_focused, '$f_widgets[1] has focus after "last" tree' );

   # Wrap-around at the top level
   $tree2->focus_next( after => $f_widgets[1] );
   ok( $f_widgets[0]->window->is_focused, '$f_widgets[0] has focus after "after" tree wraparound' );

   $tree1->focus_next( before => $f_widgets[0] );
   ok( $f_widgets[1]->window->is_focused, '$f_widgets[1] has focus after "before" tree wraparound' );

   $root->set_window( undef );
}

# Tree with unfocusable children
{
   my $tree1 = Tickit::Widget::HBox->new;
   $tree1->add( $_ ) for $f_widgets[0], $n_widgets[0];

   my $tree2 = Tickit::Widget::HBox->new;
   $tree2->add( $_ ) for $n_widgets[1], $n_widgets[2];

   my $tree3 = Tickit::Widget::HBox->new;
   $tree3->add( $_ ) for $f_widgets[1], $n_widgets[3];

   my $root = Tickit::Widget::HBox->new;
   $root->add( $_ ) for $tree1, $tree2, $tree3;

   $root->set_window( $win );

   $root->focus_next( first => undef );
   ok( $f_widgets[0]->window->is_focused, '$f_widgets[0] has focus after "first" tree sparse' );

   $tree1->focus_next( after => $f_widgets[0] );
   ok( $f_widgets[1]->window->is_focused, '$f_widgets[1] has focus after "after" tree sparse' );

   $tree2->focus_next( before => $f_widgets[1] );
   ok( $f_widgets[0]->window->is_focused, '$f_widgets[0] has focus after "before" tree sparse' );

   $root->focus_next( last => undef );
   ok( $f_widgets[1]->window->is_focused, '$f_widgets[1] has focus after "last" tree sparse' );

   $root->set_window( undef );
}

# hidden children
{
   my $root = Tickit::Widget::HBox->new;
   $root->add( $_ ) for @f_widgets;

   $root->set_window( $win );

   # Cheating
   $f_widgets[1]->window->hide;

   $root->focus_next( after => $f_widgets[0] );
   ok( !$f_widgets[1]->window->is_focused, '$f_widgets[1] does not have focus after "after" skips it' );
   ok(  $f_widgets[2]->window->is_focused, '$f_widgets[2] has focus after "after" skipped [1]' );

   $root->set_window( undef );
}

# Special method
{
   my $root = Tickit::Widget::HBox->new;
   $root->add( $_ ) for @f_widgets;

   $root->set_window( $win );

   # More cheating
   no warnings 'once';
   local *Tickit::Widget::HBox::children_for_focus = sub {
      shift;
      return $f_widgets[1], $f_widgets[2];
   };

   $root->focus_next( first => undef );
   ok( !$f_widgets[0]->window->is_focused, '$f_widgets[0] does not have focus with special method return' );
   ok(  $f_widgets[1]->window->is_focused, '$f_widgets[1] has focus with special method return' );

   $root->set_window( undef );
}

# Tab / Shift-Tab key handling
{
   my $container = Tickit::Widget::HBox->new;
   $container->set_window( $win );

   $container->add( $_ ) for $n_widgets[0], $f_widgets[0], $n_widgets[1], $f_widgets[1];

   $container->focus_next( first => undef );
   ok( $f_widgets[0]->window->is_focused, '$f_widgets[0] has focus before Tab' );

   presskey( key => "Tab" );

   ok( $f_widgets[1]->window->is_focused, '$f_widgets[1] has focus after Tab' );

   $container->set_window( undef );
}

done_testing;

package TestWidget;

use base qw( Tickit::Widget );
use constant WIDGET_PEN_FROM_STYLE => 1;

sub render_to_rb {}

sub lines { 1 }
sub cols  { 5 }

sub CAN_FOCUS { shift->{CAN_FOCUS} }

use constant KEYPRESSES_FROM_STYLE => 1;

package TestContainer;

use base qw( Tickit::Widget::HBox );

use constant WIDGET_PEN_FROM_STYLE => 1;

use Tickit::Style -copy;
BEGIN {
   style_definition ":focus-child" =>
      fg => 1;
}