# # 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; BEGIN { $Curses::Toolkit::VERSION = '0.204'; } # 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', }, } ); # 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(); # print STDERR "color is supported\n"; # print STDERR "colors number : " . COLORS . "\n"; # print STDERR "colors pairs : " . COLOR_PAIRS . "\n"; # print STDERR "can change colors ? : " . Curses::can_change_color() . "\n"; } 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, }, $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->{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; 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__ =pod =head1 NAME Curses::Toolkit - a modern Curses toolkit =head1 VERSION version 0.204 =head1 SYNOPSIS use POE::Component::Curses; use Curses::Toolkit::Widget::Window; use Curses::Toolkit::Widget::Button; # spawn a root window my $root = POE::Component::Curses->spawn(); # adds some widget $root->add_window( my $window = Curses::Toolkit::Widget::Window ->new() ->set_name('main_window') ->add_widget( my $button = Curses::Toolkit::Widget::Button ->new_with_label('Click Me to quit') ->set_name('my_button') ->signal_connect(clicked => sub { exit(0); }) ) ->set_coordinates( x1 => '20%', y1 => '20%', x2 => '80%', y2 => '80%', ) ); =head1 DESCRIPTION This module tries to be a modern curses toolkit, based on the Curses module, to build "semi-graphical" user interfaces easily. B : This is still in "beta" version, not all the features are implemented, and the API may change. However, most of the components are there, and things should not change that much in the future... Still, don't use it in production, and don't consider it stable. L is meant to be used with a mainloop, which is not part of this module. I recommend you L, which is probably what you want. L uses Curses::Toolkit, but provides a mainloop and handles keyboard, mouse, timer and other events, whereas Curses::Toolkit is just the drawing library. See the example above. the C method returns a L object, which you can call methods on. If you already have a mainloop or if you don't need it, you might want to use Curses::Toolkit directly. But again, it's probably not what you want to use. In this case you would do something like : use Curses::Toolkit; # using Curses::Toolkit without any event loop my $root = Curses::Toolkit->init_root_window(); my $window = Curses::Toolkit::Widget::Window->new(); $root->add($window); ... $root->render =head1 TUTORIAL If you are new with C, I suggest you go through the tutorial. You can find it here: L (not yet done!) =head1 WIDGETS Curses::Toolkit is based on a widget model, inspired by Gtk. I suggest you read the POD of the following widgets : =over =item L Use this widget to create a window. It's the first thing to do once you have a root_window =item L Useful to read, it contains the common methods of all the widgets =item L To display simple text, with text colors and attributes =item L Simple text button widget to interact with the user =item L A button widget that can contain anything, not just a label =item L To input text from the user =item L To pack widgets vertically, thus building complex layouts =item L To pack widgets horizontally, thus building complex layouts =item L Add a simple border around any widget =item L To pack 2 widgets horizontally with a flexible gutter =item L To pack 2 widgets vertically with a flexible gutter =item L Not yet implemented =item L Not yet implemented =item L An horizontal progress bar widget =item L A vertical progress bar widget =back For reference, here are the various hierarchy of the objects/concepts of the toolkit you might have to use : =head1 WIDGETS HIERARCHY This is the inheritance hierarchy of the widgets of the toolkit : Curses::Toolkit::Widget | +-- Curses::Toolkit::Widget::Window | | | +-- Curses::Toolkit::Widget::Window::Dialog | | | + Curses::Toolkit::Widget::Window::Dialog::About | +-- Curses::Toolkit::Widget::Label | +-- Curses::Toolkit::Widget::Entry | +-- Curses::Toolkit::Widget::Scrollbar | | | +-- Curses::Toolkit::Widget::HScrollbar | | | +-- Curses::Toolkit::Widget::VScrollbar | +-- Curses::Toolkit::Widget::Container | +-- Curses::Toolkit::Widget::HBox | +-- Curses::Toolkit::Widget::VBox | +-- Curses::Toolkit::Widget::Paned | | | +-- Curses::Toolkit::Widget::HPaned | | | +-- Curses::Toolkit::Widget::VPaned | +-- Curses::Toolkit::Widget::Bin | +-- Curses::Toolkit::Widget::Border | +-- Curses::Toolkit::Widget::Button | +-- Curses::Toolkit::Widget::GenericButton | +-- Curses::Toolkit::Widget::ProgressBar | +-- Curses::Toolkit::Widget::HProgressBar | +-- Curses::Toolkit::Widget::VProgressBar =head1 SIGNALS HIERARCHY This is the inheritance hierarchy of the signals : Curses::Toolkit::Signal | +-- Curses::Toolkit::Signal::Clicked | +-- Curses::Toolkit::Signal::Content | | | +-- Curses::Toolkit::Signal::Content::Changed | +-- Curses::Toolkit::Signal::Focused | +-- Curses::Toolkit::Signal::Focused::In | +-- Curses::Toolkit::Signal::Focused::Out =head1 THEMES HIERARCHY This is the inheritance hierarchy of the themes : Curses::Toolkit::Theme | +-- Curses::Toolkit::Theme::Default | +-- Curses::Toolkit::Theme::Default::Color | +-- Curses::Toolkit::Theme::Default::Color::Pink | +-- Curses::Toolkit::Theme::Default::Color::Yellow =head1 OBJECTS HIERARCHY This is the list of objects of the toolkit : Curses::Toolkit::Object | +-- Curses::Toolkit::Object::Coordinates | +-- Curses::Toolkit::Object::MarkupString | +-- Curses::Toolkit::Object::Shape =head1 ROLES HIERARCHY For now there is only one role Curses::Toolkit::Role::Focusable =head1 TYPES HIERARCHY For now there is only one types class : Curses::Toolkit::Types =head1 CLASS METHODS =head2 init_root_window my $root = Curses::Toolkit->init_root_window(); Initialize the Curses environment, and return an object representing it. This is not really a constructor, because you can't have more than one Curses::Toolkit object for one Curses environment. Think of it more like a service. input : theme_name : optional, the name of them to use as default display theme mainloop : optional, the mainloop object that will be used for event handling quit_key : the key used to quit the whole application. Default to 'q'. If set to undef, it's disabled switch_key : the key used to switch between windows. Default to 'r'. If set to undef, it's disabled output : a Curses::Toolkit object =head1 METHODS =head2 get_theme_name my $theme_name = $root_window->get_theme_name(); Return the theme associated with the root window. Typically used to get a usable default theme name. Use tha instead of hard-wiring 'Curses::Toolkit::Theme::Default' =head2 add_event_listener $root->add_event_listener($event_listener); Adds an event listener to the root window. That allows the root window to respond to some events input : a Curses::Toolkit::EventListener output : the root window =head2 get_event_listeners my @listeners = $root->get_event_listener(); Returns the list of listeners connected to the root window. input : none output : an ARRAY of Curses::Toolkit::EventListener =head2 get_focused_widget my $widget = $root->get_focused_widget(); Returns the widget currently focused. Warning, the returned widget could well be a window. input : none output : a Curses::Toolkit::Widget or void =head2 get_focused_window my $window = $root->get_focused_window(); Returns the window currently focused. input : none output : a Curses::Toolkit::Widget::Window or void =head2 get_focused_window my $window = $root->get_nexd_window(); Returns the next window. input : none output : a Curses::Toolkit::Widget::Window or void =head2 set_mainloop $root->set_mainloop($mainloop) Sets the mainloop object to be used by the Curses::Toolkit root object. The mainloop object will be called when a new event has to be registered. The mainloop object is in charge to listen to the events and call $root->dispatch_event() input : a mainloop object output : the Curses::Toolkit object =head2 get_mainloop my $mainloop = $root->get_mainloop() Return the mainloop object associated to the root object. Might be undef if no mainloop were associated. input : none output : the mainloop object, or undef =head2 get_shape my $coordinate = $root->get_shape(); Returns a coordinate object that represents the size of the root window. input : none output : a Curses::Toolkit::Object::Coordinates object =head2 add_window my $window = Curses::Toolkit::Widget::Window->new(); $root->add_window($window); Adds a window on the root window. Returns the root window input : a Curses::Toolkit::Widget::Window object output : the root window =head2 bring_window_to_front() $root_window->bring_window_to_front($window) Brings the window to front input : a Curses::Toolkit::Widget::Window output : the root window =head2 needs_redraw $root->needs_redraw() When called, signify to the root window that a redraw is needed. Has an effect only if a mainloop is active ( see POE::Component::Curses ) input : none output : the root window =head2 get_windows my @windows = $root->get_windows(); Returns the list of windows loaded input : none output : ARRAY of Curses::Toolkit::Widget::Window =head2 set_modal_widget Set a widget to be modal input : a widget output : the root window =head2 unset_modal_widget Unset the widget to be modal input : none output : the root window =head2 get_modal_widget returns the modal widget, or void input : none output : the modal widget or void =head2 show_all $root->show_all(); Set visibility property to true for every element. Returns the root windows input : none output : the root window =head2 render $root->render(); Build everything in the buffer. You need to call 'display' after that to display it input : none output : the root window =head2 display $root->display(); Refresh the screen. input : none output : the root window =head2 dispatch_event my $event = Curses::Toolkit::Event::SomeEvent->new(...) $root->dispatch_event($event); Given an event, dispatch it to the appropriate widgets / windows, or to the root window. You probably don't want to use this method directly. Use Signals instead. input : a Curses::Toolkit::Event optional, a widget. if given, the event dispatching will start with this wisget (and not the focused one) output : true if the event were handled, false if not =head2 fire_event $widget->fire_event($event, $widget); Sends an event to the mainloop so it gets dispatched. You probably don't want to use this method. input : a Curses::Toolkit::Event optional, a widget. if given, the event dispatching will start with this wisget (and not the focused one) output : the root_window =head2 add_delay Has an effect only if a mainloop is active ( see POE::Component::Curses ) $root_window->add_delay($seconds, \&code, @args) $root_window->add_delay(5, sub { print "wow, 5 seconds wasted, dear $_[0]\n"; }, $name); Add a timer that will execute the \&code once, in $seconds seconds. $seconds can be a fraction. @args will be passed to the code reference input : number of seconds a code reference an optional list of arguments to be passed to the code reference output : a timer unique identifier or void =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Curses::Toolkit You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =back =head1 AUTHOR Damien "dams" Krotkine =head1 COPYRIGHT AND LICENSE 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. =cut