File Coverage

blib/lib/Tickit/Widget/MenuBar.pm

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

#  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, 2012-2013 -- [e-mail]

package Tickit::Widget::MenuBar;

use strict;
use warnings;
use feature qw( switch );

use base qw( Tickit::Widget::Menu::base );
use Tickit::Style;

our $VERSION = '0.10';

use Carp;

use Tickit::RenderBuffer qw( LINE_SINGLE );
use List::Util qw( sum max );

# Re-import the constant for compiletime use
use constant separator => __PACKAGE__->separator;

=head1 NAME

C - display a menu horizontally

=head1 SYNOPSIS

 use Tickit;
 use Tickit::Widget::Menu;
 use Tickit::Widget::Menu::Item;
 use Tickit::Widget::MenuBar;
 use Tickit::Widget::VBox;

 my $tickit = Tickit->new;

 my $vbox = Tickit::Widget::VBox->new;
 $tickit->set_root_widget( $vbox );

 $vbox->add( Tickit::Widget::MenuBar->new(
    items => [
       ...
    ]
 );

 $vbox->add( ... );

 $tickit->run;

=head1 DESCRIPTION

This widget class acts as a container for menu items similar to
L but displays them horizonally in a single line. This
widget is intended to display long-term, such as in the top line of the root
window, rather than being used only transiently as a pop-up menu.

This widget should be used similarly to L, except that
its name is never useful, and it should be added to a container widget, such
as L, for longterm display. It does not have a C
or C method.

A single separator object can be added as an item, causing all the items after
it to be right-justified.

=head1 STYLE

The default style pen is used as the widget pen. The following style pen
prefixes are also used:

=over 4

=item highlight => PEN

The pen used to highlight the active menu selection

=back

The following style actions are used:

=over 4

=item highlight_next ()

=item highlight_prev ()

Highlight the next or previous item

=item highlight_first ()

Highlight the first menu item

=item activate ()

Activate the highlighted item

=item dismiss ()

Dismiss the menu

=back

=cut

style_definition base =>
   rv => 1,
   highlight_rv => 0,
   highlight_bg => "green",
   "" => "highlight_next",
   ""  => "highlight_prev",
   ""   => "highlight_first",
   ""  => "activate",
   "" => "dismiss";

use constant KEYPRESSES_FROM_STYLE => 1;
use constant WIDGET_PEN_FROM_STYLE => 1;

sub lines
{
   return 1;
}

sub cols
{
   my $self = shift;
   return sum( map { $self->_itemwidth( $_ ) } 0 .. $self->items-1 ) + 2 * ( $self->items - 1 );
}

sub push_item
{
   my $self = shift;
   my ( $item ) = @_;

   if( $item == separator and grep { $_ == separator } $self->items ) {
      croak "Cannot have more than one separator in a MenuBar";
   }

   $self->SUPER::push_item( $item );
}

sub reshape
{
   my $self = shift;

   $self->{itempos} = \my @pos;

   my $items = $self->{items};
   my $col = 0;
   my $separator_at;
   foreach my $idx ( 0 .. $#$items ) {
      $separator_at = $idx, next if $items->[$idx] == separator;

      $pos[$idx] = [ $col, undef ];
      $col += $self->_itemwidth( $idx );
      $pos[$idx][1] = $col;
      $col += 2;
   }

   if( defined $separator_at ) {
      $col -= 2; # undo
      my $spare = $self->window->cols - $col;

      $pos[$_][0] += $spare, $pos[$_][1] += $spare for $separator_at+1 .. $#$items;
   }
}

sub pos2item
{
   my $self = shift;
   my ( $line, $col ) = @_;

   $line == 0 or return ();

   my $items = $self->{items};
   my $pos   = $self->{itempos};

   foreach my $idx ( 0 .. $#$items ) {
      next if !defined $pos->[$idx]; # separator
      last if     $col < $pos->[$idx][0];
      next unless $col < $pos->[$idx][1];

      $col -= $pos->[$idx][0];

      return () if $col < 0;
      return ( $items->[$idx], $idx, $col );
   }

   return ();
}

sub redraw_item
{
   my $self = shift;
   my ( $idx ) = @_;
   $self->window->expose( Tickit::Rect->new(
      top => 0, lines => 1,
      left  => $self->{itempos}[$idx][0],
      right => $self->{itempos}[$idx][1],
   ) );
}

sub render_to_rb
{
   my $self = shift;
   my ( $rb, $rect ) = @_;

   if( $rect->top == 0 ) {
      $rb->goto( 0, 0 );

      my @items = $self->items;
      foreach my $idx ( 0 .. $#items ) {
         my $item = $items[$idx];
         next if $item == separator;

         my ( $left, $right ) = @{ $self->{itempos}[$idx] };
         last if $left > $rect->right;
         next if $right < $rect->left;

         $rb->erase_to( $left );

         my $pen = defined $self->{active_idx} && $idx == $self->{active_idx}
                     ? $self->get_style_pen( "highlight" ) : undef;

         $rb->savepen;
         $rb->setpen( $pen );

         $item->render_label( $rb, $right - $left, $self );

         $rb->restore;
      }

      $rb->erase_to( $rect->right );
   }

   foreach my $line ( $rect->linerange( 1, undef ) ) {
      $rb->erase_at( $line, $rect->left, $rect->cols );
   }
}

sub popup_item
{
   my $self = shift;
   my ( $idx ) = @_;

   my $items = $self->{items};

   my $col = $self->{itempos}[$idx][0];

   my $rightmost = $self->window->cols - $items->[$idx]->cols;
   $col = $rightmost if $col > $rightmost;

   $items->[$idx]->popup( $self->window, 1, $col );
}

sub activated
{
   my $self = shift;
   $self->dismiss;
}

sub dismiss
{
   my $self = shift;
   $self->SUPER::dismiss;

   # Still have a window after ->dismiss
   $self->redraw;
}

sub on_key
{
   my $self = shift;

   # Always eat all the keys as there's never anything higher to pass them to
   return 1;
}

# MenuBar always expands on highlight
sub key_highlight_next
{
   my $self = shift;
   $self->SUPER::key_highlight_next;
   $self->expand_item( $self->{active_idx} );
}

sub key_highlight_prev
{
   my $self = shift;
   $self->SUPER::key_highlight_prev;
   $self->expand_item( $self->{active_idx} );
}

sub key_highlight_first
{
   my $self = shift;
   defined $self->{active_idx} or $self->expand_item( 0 );
   return 1;
}

sub on_mouse_item
{
   my $self = shift;
   my ( $args, $item, $item_idx, $item_col ) = @_;

   # We only ever care about button 1
   return unless $args->button == 1;

   my $event = $args->type;
   if( $event eq "press" ) {
      # A second click on an active item deactivates
      if( defined $self->{active_idx} and $item_idx == $self->{active_idx} ) {
         $self->dismiss;
      }
      else {
         $self->expand_item( $item_idx );
      }
   }
   elsif( $event eq "drag" ) {
      $self->expand_item( $item_idx );
   }

   return 1;
}

=head1 AUTHOR

Paul Evans

=cut

0x55AA;