File Coverage

blib/lib/Curses/Toolkit.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

#
# This file is part of Curses-Toolkit
#
# This software is copyright (c) 2011 by Damien "dams" Krotkine.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use warnings;
use strict;

package Curses::Toolkit;
{
  $Curses::Toolkit::VERSION = '0.211';
}

# ABSTRACT: a modern Curses toolkit

use Params::Validate qw(SCALAR ARRAYREF HASHREF CODEREF GLOB GLOBREF SCALARREF HANDLE BOOLEAN UNDEF validate validate_pos);

use Curses::Toolkit::Theme;


sub init_root_window {
    my $class = shift;

    my %params = validate(
        @_,
        {   theme_name => {
                type     => SCALAR,
                optional => 1,
            },
            mainloop => { optional => 1 },
            quit_key => {
                type    => SCALAR,
                default => 'q',
            },
            switch_key => {
                type    => SCALAR,
                default => 'r',
            },
            test_environment => {
                type    => HASHREF,
                optional => 1,
            },
        }
    );

    # get the Curses handler
    use Curses;
    my $curses_handler = Curses->new();

    # already done ?
    #     raw();
    #     cbreak();
    #     noecho();
    #     $curses_handler->keypad(1);

    if (has_colors) {
        start_color();
    }

    eval { Curses->can('NCURSES_MOUSE_VERSION') && ( NCURSES_MOUSE_VERSION() >= 1 ) };

    my $old_mouse_mask;
    my $mouse_mask = mousemask( ALL_MOUSE_EVENTS | REPORT_MOUSE_POSITION, $old_mouse_mask );

    use Curses::Toolkit::Theme::Default;
    use Curses::Toolkit::Theme::Default::Color::Yellow;
    use Curses::Toolkit::Theme::Default::Color::Pink;
    use Curses::Toolkit::Theme::Default::Color::BlueWhite;

    use Tie::Array::Iterable;
    $params{theme_name} ||= Curses::Toolkit->get_default_theme_name();
    my @windows = ();
    my $self    = bless {
        initialized     => 1,
        curses_handler  => $curses_handler,
        windows         => Tie::Array::Iterable->new(@windows),
        theme_name      => $params{theme_name},
        mainloop        => $params{mainloop},
        last_stack      => 0,
        event_listeners => [],
        window_iterator => undef,
        test_environment => $params{test_environment},
    }, $class;
    $self->_recompute_shape();

    use Curses::Toolkit::EventListener;

    # add a default listener that listen to any Shape event
    $self->add_event_listener(
        Curses::Toolkit::EventListener->new(
            accepted_events => {
                'Curses::Toolkit::Event::Shape' => sub { 1; },
            },
            code => sub {
                my ( $screen_h, $screen_w );
                $self->_recompute_shape();

                # for now we rebuild all coordinates
                foreach my $window ( $self->get_windows() ) {
                    $window->rebuild_all_coordinates();
                }
            },
        )
    );
    if ( defined $params{quit_key} ) {
        $self->add_event_listener(
            Curses::Toolkit::EventListener->new(
                accepted_events => {
                    'Curses::Toolkit::Event::Key' => sub {
                        my ($event) = @_;
                        $event->{type} eq 'stroke' or return 0;
                        lc $event->{params}{key} eq $params{quit_key} or return 0;
                    },
                },
                code => sub {
                    exit;
                },
            )
        );
    }
    if ( defined $params{switch_key} ) {
        $self->add_event_listener(
            Curses::Toolkit::EventListener->new(
                accepted_events => {
                    'Curses::Toolkit::Event::Key' => sub {
                        my ($event) = @_;
                        $event->{type} eq 'stroke' or return 0;
                        lc $event->{params}{key} eq $params{switch_key} or return 0;
                    },
                },
                code => sub {
                    my ( $event, $widget ) = @_;
                    defined $self->{window_iterator}
                        or return;
                    my $window = $widget->{window_iterator}->next();
                    if ( !defined $window ) {
                        $widget->{window_iterator}->to_start();
                        $window = $widget->{window_iterator}->value();
                    }

                    # get the currently focused widget, unfocus it
                    my $current_focused_widget = $self->get_focused_widget();
                    if ( defined $current_focused_widget && $current_focused_widget->can('set_focus') ) {
                        $current_focused_widget->set_focus(0);
                    }
                    $window->bring_to_front();

                    # focus the window or one of its component
                    my $next_focused_widget =
                        $window->get_next_focused_widget(1); # 1 means "consider if $window is focusable"
                    defined $next_focused_widget
                        and $next_focused_widget->set_focus(1);
                },
            )
        );
    }

    # key listener for TAB
    $self->add_event_listener(
        Curses::Toolkit::EventListener->new(
            accepted_events => {
                'Curses::Toolkit::Event::Key' => sub {
                    my ($event) = @_;
                    $event->{type} eq 'stroke' or return 0;
                    $event->{params}{key} eq '<^I>' or return 0;
                },
            },
            code => sub {
                my $focused_widget = $self->get_focused_widget();
                if ( defined $focused_widget ) {
                    my $next_focused_widget = $focused_widget->get_next_focused_widget();
                    defined $next_focused_widget
                        and $next_focused_widget->set_focus(1);
                } else {
                    my $focused_window      = $self->get_focused_window();
                    my $next_focused_widget = $focused_window->get_next_focused_widget();
                    defined $next_focused_widget
                        and $next_focused_widget->set_focus(1);
                }
            },
        )
    );

    # key listener for BACK TAB
    $self->add_event_listener(
        Curses::Toolkit::EventListener->new(
            accepted_events => {
                'Curses::Toolkit::Event::Key' => sub {
                    my ($event) = @_;
                    $event->{type} eq 'stroke' or return 0;
                    $event->{params}{key} eq 'KEY_BTAB' or return 0;
                },
            },
            code => sub {

                #  my $focused_widget = $self->get_focused_widget();
                #  if (defined $focused_widget) {
                #      my $prev_focused_widget = $focused_widget->get_prev_focused_widget();
                #      defined $prev_focused_widget and
                #        $prev_focused_widget->set_focus(1);
                #  } else {
                #      my $focused_window = $self->get_focused_window();
                #      my $prev_focused_widget = $focused_window->get_prev_focused_widget();
                #      defined $prev_focused_widget and
                #        $prev_focused_widget->set_focus(1);
                #  }
            },
        )
    );

    return $self;
}

sub get_default_theme_name {
    my ($class) = @_;
    return (
        has_colors()
        ? 'Curses::Toolkit::Theme::Default::Color::BlueWhite'
        : 'Curses::Toolkit::Theme::Default'
    );

    # 'Curses::Toolkit::Theme::Default::Color::Yellow'
    # 'Curses::Toolkit::Theme::Default::Color::Pink'
}


# destroyer
DESTROY {
    my ($obj) = @_;

    # ending Curses
    ref($obj) eq 'Curses::Toolkit'
        and Curses::endwin;
}



sub get_theme_name {
    my ($self) = @_;
    return $self->{theme_name};
}



sub add_event_listener {
    my $self = shift;
    my ($listener) = validate_pos( @_, { isa => 'Curses::Toolkit::EventListener' } );
    push @{ $self->{event_listeners} }, $listener;
    return $self;
}


sub get_event_listeners {
    my ($self) = @_;
    return @{ $self->{event_listeners} };
}


sub get_focused_widget {
    my ($self) = @_;
    my $window = $self->get_focused_window();
    defined $window or return;
    return $window->get_focused_widget();
}


sub get_focused_window {
    my ($self) = @_;
    my @windows = $self->get_windows();
    @windows or return;
    my $window =
        ( sort { $b->get_property( window => 'stack' ) <=> $a->get_property( window => 'stack' ) } @windows )[0];
    return $window;
}


# sub get_next_window {
#     my ($self) = @_;
#     my $iterator = $window->{window_iterator}
#       or return;
#     $iterator->next();
#     my $sister_window = $iterator->value(); # might be undef
#     $iterator->prev();
#     defined $sister_window and return $sister_window;
#     return;
# }


sub set_mainloop {
    my $self = shift;
    my ($mainloop) = validate_pos( @_, { optional => 0 } );
    $self->{mainloop} = $mainloop;
    return $self;
}


sub get_mainloop {
    my ($self) = @_;
    return $self->{mainloop};
}


sub get_shape {
    my ($self) = @_;
    return $self->{shape};
}


sub add_window {
    my $self = shift;
    my ($window) = validate_pos( @_, { isa => 'Curses::Toolkit::Widget::Window' } );
    $window->_set_curses_handler( $self->{curses_handler} );
    $window->set_theme_name( $self->{theme_name} );
    $window->set_root_window($self);
    $self->bring_window_to_front($window);

    # in case the window has proportional coordinates depending on the root window
    # TODO : do that only if window has proportional coordinates, not always
    $window->rebuild_all_coordinates();
    push @{ $self->{windows} }, $window;
    $self->{window_iterator} ||= $self->{windows}->forward_from();
    $self->needs_redraw();
    return $self;
}


sub bring_window_to_front {
    my $self = shift;
    my ($window) = validate_pos( @_, { isa => 'Curses::Toolkit::Widget::Window' } );
    $self->{last_stack}++;
    $window->set_property( window => 'stack', $self->{last_stack} );
    my $last_stack = $self->{last_stack};
    $last_stack % 5 == 0
        and $self->{last_stack} = $self->_cleanup_windows_stacks();

    $self->needs_redraw();
    return $self;
}

sub _cleanup_windows_stacks {
    my ($self) = @_;

    my @sorted_windows =
        sort { $a->get_property( window => 'stack' ) <=> $b->get_property( window => 'stack' ) } $self->get_windows();

    foreach my $idx ( 0 .. @sorted_windows - 1 ) {
        $sorted_windows[$idx]->set_property( window => 'stack', $idx );
    }
    return @sorted_windows - 1;
}


sub needs_redraw {
    my ($self) = @_;
    my $mainloop = $self->get_mainloop();
    defined $mainloop or return $self;
    $mainloop->needs_redraw();
    return $self;
}


sub get_windows {
    my ($self) = @_;
    return @{ $self->{windows} };
}


sub set_modal_widget {
    my $self = shift;
    my ($widget) = validate_pos( @_, { isa => 'Curses::Toolkit::Widget' } );
    $self->{_modal_widget} = $widget;
    return $self;
}


sub unset_modal_widget {
    my $self = shift;
    $self->{_modal_widget} = undef;
    return;
}


sub get_modal_widget {
    my ($self) = @_;

    my $modal_widget = $self->{_modal_widget};
    defined $modal_widget or return;
    return $modal_widget;
}


sub show_all {
    my ($self) = @_;
    foreach my $window ( $self->get_windows() ) {
        $window->show_all();
    }
    return $self;
}




sub render {
    my ($self) = @_;

    $self->{test_environment}
      or $self->{curses_handler}->erase();

    if (!defined $self->{_root_theme}) {
        $self->{_root_theme} = $self->get_theme_name->new(Curses::Toolkit::Widget::Window->new());
        $self->{_root_theme}->_set_colors($self->{_root_theme}->ROOT_COLOR, $self->{_root_theme}->ROOT_COLOR);
    }
    my $root_theme = $self->{_root_theme};

    my $c = $self->{shape};
    my $str = ' ' x ($c->get_x2() - $c->get_x1());
    $self->{curses_handler}->attron($root_theme->_get_color_pair);
    foreach my $y ( $c->get_y1() .. $c->get_y2() - 1 ) {
        $self->{curses_handler}->addstr( $y, $c->get_x1(), $str );
    }

    foreach my $window ( sort { $a->get_property( window => 'stack' ) <=> $b->get_property( window => 'stack' ) }
        $self->get_windows() )
    {
        $window->render();
    }
    return $self;
}


sub display {
    my ($self) = @_;
    $self->{curses_handler}->refresh();
    return $self;
}


sub dispatch_event {
    my $self = shift;
    my ( $event, $widget ) = validate_pos(
        @_, { isa => 'Curses::Toolkit::Event' },
        { isa => 'Curses::Toolkit::Widget', optional => 1 },
    );

    if ( !defined $widget ) {
        $widget = $self->get_modal_widget();
        defined $widget and $self->unset_modal_widget();
    }
    $widget ||= $event->get_matching_widget();
    defined $widget or return;

    while (1) {
        foreach my $listener ( grep { $_->is_enabled() } $widget->get_event_listeners() ) {
            if ( $listener->can_handle($event) ) {
                $listener->send_event( $event, $widget );
                $event->can_propagate()
                    or return 1;
            }
        }
        $event->restricted_to_widget()
            and return;
        if ( $widget->isa('Curses::Toolkit::Widget::Window') ) {
            $widget = $widget->get_root_window();
        } elsif ( $widget->isa('Curses::Toolkit::Widget') ) {
            $widget = $widget->get_parent();
        } else {
            return;
        }
        defined $widget or return;
    }
    return;
}


sub fire_event {
    my $self = shift;
    my ( $event, $widget ) = validate_pos(
        @_, { isa => 'Curses::Toolkit::Event' },
        { isa => 'Curses::Toolkit::Widget', optional => 1 },
    );
    my $mainloop = $self->get_mainloop();
    defined $mainloop or return $self;
    $mainloop->stack_event( $event, $widget );
    return $self;
}


sub add_delay {
    my $self     = shift;
    my $mainloop = $self->get_mainloop();
    defined $mainloop or return;
    $mainloop->add_delay(@_);
    return;
}

# ## Private methods ##

# # event_handling

# my @supported_events = (qw(Curses::Toolkit::Event::Shape));
# sub _handle_event {
#     my ($self, $event) = @_;
#     use List::MoreUtils qw(any);
#     if ( any { $event->isa($_) } @supported_events ) {
#         my $method_name = '_event_' . lc( (split('::|_', ref($event)))[-1] ) . '_' .  $event->get_type();
#         if ($self->can($method_name)) {
#             return $self->$method_name();
#         }
#     }
#     # event failed being applied
#     return 0;
# }

# core event handling for Curses::Toolkit::Event::Shape event of type 'change'
sub _event_shape_change {
    my ($self) = @_;

    my ( $screen_h, $screen_w );
    $self->_recompute_shape();

    # for now we rebuild all coordinates
    foreach my $window ( $self->get_windows() ) {
        $window->rebuild_all_coordinates();
    }

    # for now rebuild everything
    #    my $mainloop = $self->get_mainloop();
    #    if (defined $mainloop) {
    #        $mainloop->needs_redraw();
    #    }

    # event suceeded
    return 1;

}

sub _recompute_shape {
    my ($self) = @_;
    use Curses::Toolkit::Object::Coordinates;
    my ( $screen_h, $screen_w );
    use Curses;
    if ($self->{test_environment}) {
        $screen_h = $self->{test_environment}->{screen_h};
        $screen_w = $self->{test_environment}->{screen_w};
    } else {
        endwin;
        $self->{curses_handler}->getmaxyx( $screen_h, $screen_w );
    }
    use Curses::Toolkit::Object::Shape;
    $self->{shape} ||= Curses::Toolkit::Object::Shape->new_zero();
    $self->{shape}->_set(
        x2 => $screen_w,
        y2 => $screen_h,
    );
    return $self;
}

sub _rebuild_all {
    my ($self) = @_;
    foreach my $window ( $self->get_windows() ) {
        $window->rebuild_all_coordinates();
    }
    return $self;
}

1;

__END__