view release on metacpan or  search on metacpan

lib/Tickit/Widget.pm  view on Meta::CPAN

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2009-2018 -- leonerd@leonerd.org.uk

package Tickit::Widget;

use strict;
use warnings;

our $VERSION = '0.53';

use Carp;
use Scalar::Util qw( weaken );
use List::Util 1.33 qw( all );

use Tickit::Pen;
use Tickit::Style;
use Tickit::Utils qw( textwidth );
use Tickit::Window 0.57;  # $win->bind_event
use Tickit::Event 0.63;  # $info->type("newapi") on Focus

use constant PEN_ATTR_MAP => { map { $_ => 1 } @Tickit::Pen::ALL_ATTRS };

use constant KEYPRESSES_FROM_STYLE => 0;

use constant CAN_FOCUS => 0;

=head1 NAME

C<Tickit::Widget> - abstract base class for on-screen widgets

=head1 DESCRIPTION

This class acts as an abstract base class for on-screen widget objects. It
provides the lower-level machinery required by most or all widget types.

Objects cannot be directly constructed in this class. Instead, a subclass of
this class which provides a suitable implementation of the C<render_to_rb> and
other provided methods is derived. Instances in that class are then
constructed.

See the C<EXAMPLES> section below.

The core F<Tickit> distribution only contains a couple of simple widget
classes. Many more widget types are available on CPAN. Almost certainly for
any widget-based program you will want to at least install the
L<Tickit::Widgets> distribution, which provides many of the basic UI types of
widget.

=head1 STYLE

The following style tags are used on all widget classes that use Style:

=over 4

=item :focus

Set when this widget has the input focus

=back

The following style actions are used:

=over 4

=item focus_next_before (<Tab>)

=item focus_next_after (<S-Tab>)

Requests the focus move to the next or previous focusable widget in display
order.

=back

lib/Tickit/Widget.pm  view on Meta::CPAN

      $self->reshape;
      $self->redraw;
   }
   elsif( keys %changed_pens or $redraw ) {
      $self->redraw;
   }
}

=head2 set_window

   $widget->set_window( $window )

Sets the L<Tickit::Window> for the widget to draw on. Setting C<undef> removes
the window.

If a window is associated to the widget, that window's pen is set to the
current widget pen. The widget is then drawn to the window by calling the
C<render_to_rb> method. If a window is removed (by setting C<undef>) then no
cleanup of the window is performed; the new owner of the window is expected to
do this.

This method may invoke the C<window_gained> and C<window_lost> methods.

=cut

sub set_window
{
   my $self = shift;
   my ( $window ) = @_;

   # Early out if no change
   return if !$window and !$self->window;
   return if $window and $self->window and $self->window == $window;

   if( $self->{window} and !$window ) {
      $self->{window}->set_pen( undef );
      $self->window_lost( $self->{window} );
   }

   $self->{window} = $window;

   if( $window ) {
      $window->set_pen( $self->{pen} );

      $self->window_gained( $self->{window} );

      $window->take_focus if delete $self->{focus_pending};

      $self->reshape;

      $window->expose;
   }
}

sub window_gained
{
   my $self = shift;

   my $window = $self->window;

   weaken $self;

   my $event_ids = $self->{event_ids} //= {};

   $event_ids->{geomchange} = $window->bind_event( geomchange => sub {
      $self->reshape;
      $self->redraw if !$self->parent;
   } );

   $event_ids->{expose} = $window->bind_event( expose => sub {
      my ( $win, undef, $info ) = @_;
      $win->is_visible or return;

      $info->rb->setpen( $self->{pen} );

      $self->render_to_rb( $info->rb, $info->rect );
   });

   $event_ids->{focus} = $window->bind_event( focus => sub {
      my ( $win, undef, $info ) = @_;
      $self->_on_win_focus( $win, $info->type( "newapi" ), $info->win );
   } ) if $self->can( "_widget_style_type" );

   if( $self->can( "on_key" ) or $self->KEYPRESSES_FROM_STYLE ) {
      $event_ids->{key} = $window->bind_event( key => sub {
         my ( $win, undef, $info ) = @_;

         {
            # Space comes as " " but we'd prefer to use "Space" in styles
            my $keystr = $info->str eq " " ? "Space" : $info->str;

            my $action;
            $action = $self->get_style_values( "<$keystr>" ) if $self->KEYPRESSES_FROM_STYLE;
            $action //= "focus_next_after"  if $keystr eq "Tab";
            $action //= "focus_next_before" if $keystr eq "S-Tab";

            last unless $action;

            my $code = $self->can( "key_$action" );
            return 1 if $code and $code->( $self, $info );
         }
         my $code = $self->can( "on_key" );
         return 1 if $code and $code->( $self, $info );
      } );
   }

   $event_ids->{mouse} = $window->bind_event( mouse => sub {
      my ( $win, undef, $info ) = @_;
      $self->take_focus if $self->CAN_FOCUS and $info->button == 1 and $info->type eq "press";
      $self->on_mouse( $info ) if $self->can( "on_mouse" );
   } );
}

sub _on_win_focus
{
   my $self = shift;
   my ( $win, $focus ) = @_;

   $self->set_style_tag( focus => $focus eq "in" );
}

sub key_focus_next_after
{
   my $self = shift;
   $self->parent and $self->parent->focus_next( after => $self );
   return 1;
}

sub key_focus_next_before
{
   my $self = shift;
   $self->parent and $self->parent->focus_next( before => $self );
   return 1;
}

sub window_lost
{
   my $self = shift;

   my $window = $self->window;

   $window->unbind_event_id( $_ ) for values %{ $self->{event_ids} };
}

=head2 window

   $window = $widget->window

Returns the current window of the widget, if one has been set using
C<set_window>.

=cut

sub window
{
   my $self = shift;
   return $self->{window};
}

=head2 set_parent

   $widget->set_parent( $parent )

Sets the parent widget; pass C<undef> to remove the parent.

C<$parent>, if defined, must be a subclass of L<Tickit::ContainerWidget>.

=cut

sub set_parent
{
   my $self = shift;
   my ( $parent ) = @_;

   !$parent or $parent->isa( "Tickit::ContainerWidget" ) or croak "Parent must be a ContainerWidget";

   weaken( $self->{parent} = $parent );
}

=head2 parent

   $parent = $widget->parent

Returns the current container widget

=cut

sub parent
{
   my $self = shift;
   return $self->{parent};
}

=head2 resized

   $widget->resized

Provided for subclasses to call when their size requirements have or may have
changed. Re-calculates the size requirements by calling C<lines> and C<cols>
again, then calls C<set_requested_size>.

=cut

sub resized
{
   my $self = shift;
   # 'scalar' just in case of odd behaviour in subclasses
   $self->set_requested_size( scalar $self->lines, scalar $self->cols );
}

=head2 set_requested_size

   $widget->set_requested_size( $lines, $cols )

Provided for subclasses to call when their size requirements have or may have
changed. Informs the parent that the widget requires a differently-sized
window if the dimensions are now different to last time.

=cut

sub set_requested_size
{
   my $self = shift;
   my ( $new_lines, $new_cols ) = @_;

   return if defined $self->{req_lines} and $self->{req_lines} == $new_lines and
             defined $self->{req_cols}  and $self->{req_cols}  == $new_cols;

   $self->{req_lines} = $new_lines;
   $self->{req_cols}  = $new_cols;

   if( $self->parent ) {
      $self->parent->child_resized( $self );
   }
   else {
      $self->reshape if $self->window;
      $self->redraw;