view release on metacpan or  search on metacpan

Widgets/Menu.pm  view on Meta::CPAN

Curses::Widgets::Menu provides simplified OO access to menus.  Each item in a
menu can be tied to a subroutine reference which is called when selected.

=cut

#####################################################################
#
# Environment definitions
#
#####################################################################

package Curses::Widgets::Menu;

use strict;
use vars qw($VERSION @ISA);
use Carp;
use Curses;
use Curses::Widgets;
use Curses::Widgets::ListBox;

($VERSION) = (q$Revision: 1.103 $ =~ /(\d+(?:\.(\d+))+)/);
@ISA = qw(Curses::Widgets);

#####################################################################
#
# Module code follows
#
#####################################################################

=head1 METHODS

=head2 new (inherited from Curses::Widgets)

  $menu = Curses::Widgets::Menu->new({
    INPUTFUNC   => \&scankey,
    FOREGROUND  => undef,
    BACKGROUND  => 'black',
    FOCUSSWITCH => "\t",
    MENUS       => {
      MENUORDER => [qw(File)],
      File      => {
        ITEMORDER => [qw(Save Quit)],
        Save      => \&Save,
        Quit      => \&Quit,
      },
    CURSORPOS   => 'File',
    BORDER      => 1,
    });

The new method instantiates a new Menu object.  The only mandatory
key/value pairs in the configuration hash are B<X> and B<Y>.  All others
have the following defaults:

  Key           Default  Description
  ============================================================
  INPUTFUNC   \&scankey  Function to use to scan for keystrokes
  FOREGROUND      undef  Default foreground colour
  BACKGROUND    'black'  Default background colour
  FOCUSSWITCH      "\t"  Characters which signify end of input
  MENUS              {}  Menu structure
  CURSORPOS          ''  Current position of the cursor
  BORDER              0  Avoid window borders

The B<MENUS> option is a hash of hashes, with each hash a separate menu, and
the constituent hashes being a Entry/Function pairs.  Each hash requires a
special key/value pair that determines the order of the items when displayed.
Each item is separated by two spaces.

=cut

sub _conf {
  # Validates and initialises the new Menu object.
  #
  # Internal use only.

  my $self = shift;
  my %conf = ( 
    INPUTFUNC     => \&scankey,
    FOREGROUND    => undef,
    BACKGROUND    => 'black',
    FOCUSSWITCH   => "\t",
    MENUS         => {MENUORDER => []},
    BORDER        => 0,
    EXIT          => 0,
    CURSORPOS     => '',
    @_ 
    );
  my $err = 0;

  # Set the default CURSORPOS if undefined
  $conf{CURSORPOS} = $conf{MENUS}{MENUORDER}[0] unless 
    defined $conf{CURSORPOS};

  # Make sure no errors are returned by the parent method
  $err = 1 unless $self->SUPER::_conf(%conf);

  # Get the updated conf hash
  %conf = ();
  %conf = %{$self->{CONF}};

  # Create a listbox as our popup menu
  $self->{LISTBOX} = Curses::Widgets::ListBox->new({
      X           => 0,
      Y           => 0,
      LISTITEMS   => [],
      FOREGROUND  => $conf{FOREGROUND},
      BACKGROUND  => $conf{BACKGROUND},
      LINES       => 3,
      COLUMNS     => 10,
      FOCUSSWITCH => "\n\e",
      INPUTFUNC   => $conf{INPUTFUNC},
    }) unless $err;

  return $err == 0 ? 1 : 0;
}

=head2 draw

  $menu->draw($mwh, 1);

The draw method renders the menu in its current state.  This
requires a valid handle to a curses window in which it will render
itself.  The optional second argument, if true, will cause the selection
cursor to be rendered as well.

=cut

sub draw {
  my $self = shift;
  my $mwh = shift;
  my $active = shift;
  my $conf = $self->{CONF};
  my ($y, $x);

  # Get the parent window's (max|beg)yx and save the info
  $mwh->getmaxyx($y, $x);
  $$conf{COLUMNS} = $x;
  $mwh->getbegyx($y, $x);
  $self->{BEGYX} = [$y, $x];

  # Call the parent's draw method
  return $self->SUPER::draw($mwh, $active);
}

sub _geometry {
  my $self = shift;
  my $conf = $self->{CONF};
  my @rv = (1, $$conf{COLUMNS}, 0, 0);

  if ($$conf{BORDER}) {
    $rv[1] -= 2;
    @rv[2,3] = (1, 1);
  }

  return @rv;
}

sub _cgeometry {
  my $self = shift;
  my $conf = $self->{CONF};
  my @rv = (1, $$conf{COLUMNS}, 0, 0);

  $rv[1] -= 2 if $$conf{BORDER};

  return @rv;
}

sub _border {
  # Make sure no one tries to call this on a menu
}

sub _caption {
  # Make sure no one tries to call this on a menu
}

sub _content {
  my $self = shift;
  my $dwh = shift;
  my $conf = $self->{CONF};
  my $menu = $$conf{MENUS};
  my $label;

  # Print the labels
  $label = join(' ', @{$$menu{MENUORDER}});
  carp ref($self), ":  Window not wide enough to display all menus!"
    if length($label) > $$conf{COLUMNS} - 2 * $$conf{BORDER};
  $dwh->addstr(0, 0, $label);
}

sub _cursor {
  my $self = shift;
  my $dwh = shift;
  my $conf = $self->{CONF};
  my $menu = $$conf{MENUS};
  my $pos = $$conf{CURSORPOS};
  my ($x, $label);

  # Get the x coordinate of the cursor and display the cursor
  $label = join(' ', @{$$menu{MENUORDER}});
  if ($label =~ /^(.*\b)\Q$pos\E\b/) {
    $x = length($1);
    $dwh->chgat(0, $x, length($pos), A_STANDOUT, select_colour(
      @$conf{qw(FOREGROUND BACKGROUND)}), 0);
  }

  $self->_restore($dwh);
}

=head2 popup

  $menu->popup;

This method causes the menu to be displayed.  Since, theoretically, the menu 
should never be seen unless it's being actively used, we will always assume 
that we need to draw a cursor on the list as well.

=cut

sub popup {
  my $self = shift;
  my $conf = $self->{CONF};
  my ($x, $y, $border) = (@$conf{qw(X Y)}, 1);
  my $lb = $self->{LISTBOX};
  my ($pwh, $items, $cp, $in, $rv, $l);

  # Calculate the border column/lines
  $border *= 2;

  # Create the popup window
  unless ($pwh = newwin($lb->getField('LINES') + $border, 
    $lb->getField('COLUMNS') + $border, $y, $x)) {
    carp ref($self), ":  Popup creation failed, possible geometry problems";
    return;
  }
  $pwh->keypad(1);

  # Render the list box
  $rv = $lb->execute($pwh);

  # Release the window
  $pwh->delwin;

  # Exit now if $rv is an escape
  return undef if $rv =~ /\e/;

  # Return the menu selection
  ($cp, $items) = $lb->getField(qw(CURSORPOS LISTITEMS));
  return $$items[$cp] if (defined $cp && scalar @$items);
}

sub input_key {
  # Process input a keystroke at a time.
  #
  # Internal use only.

  my $self = shift;
  my $in = shift;
  my $conf = $self->{CONF};
  my $lb = $self->{LISTBOX};
  my ($menus, $pos) = @$conf{qw(MENUS CURSORPOS)};
  my ($width, $height, $x, $y, $i, $j, $item, $rv, $sub, $l);

  return unless @{$$menus{MENUORDER}};

  # Get the current menu index
  $i = 0;
  while ($i < @{$$menus{MENUORDER}} && 
    $$menus{MENUORDER}[$i] ne $pos) { $i++ };
  $item = $$menus{MENUORDER}[$i];

  # Process special keys
  if ($in eq KEY_LEFT) {
    --$i;
    $i = $#{$$menus{MENUORDER}} if $i < 0;
  } elsif ($in eq KEY_RIGHT) {