# Curses::Widgets::ListBox.pm -- List Box Widgets
#
# (c) 2001, Arthur Corliss <corliss@digitalmages.com>
#
# $Id: ListBox.pm,v 1.104 2002/11/14 01:20:28 corliss Exp corliss $
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#####################################################################
=head1 NAME
Curses::Widgets::ListBox - List Box Widgets
=head1 MODULE VERSION
$Id: ListBox.pm,v 1.104 2002/11/14 01:20:28 corliss Exp corliss $
=head1 SYNOPSIS
use Curses::Widgets::ListBox;
$lb = Curses::Widgets::ListBox->new({
CAPTION => 'List',
CAPTIONCOL => 'yellow',
COLUMNS => 10,
LINES => 3,
VALUE => 0,
INPUTFUNC => \&scankey,
FOREGROUND => 'white',
BACKGROUND => 'black',
SELECTEDCOL => 'green',
BORDER => 1,
BORDERCOL => 'red',
FOCUSSWITCH => "\t",
X => 1,
Y => 1,
TOPELEMENT => 0,
LISTITEMS => [@list],
});
$lb->draw($mwh, 1);
See the Curses::Widgets pod for other methods.
=head1 REQUIREMENTS
=over
=item Curses
=item Curses::Widgets
=back
=head1 DESCRIPTION
Curses::Widgets::ListBox provides simplified OO access to Curses-based
single/multi-select list boxes. Each object maintains its own state
information.
=cut
#####################################################################
#
# Environment definitions
#
#####################################################################
package Curses::Widgets::ListBox;
use strict;
use vars qw($VERSION @ISA);
use Carp;
use Curses;
use Curses::Widgets;
($VERSION) = (q$Revision: 1.104 $ =~ /(\d+(?:\.(\d+))+)/);
@ISA = qw(Curses::Widgets);
#####################################################################
#
# Module code follows
#
#####################################################################
=head1 METHODS
=head2 new (inherited from Curses::Widgets)
$tm = Curses::Widgets::ListBox->new({
CAPTION => 'List',
CAPTIONCOL => 'yellow',
COLUMNS => 10,
LINES => 3,
VALUE => 0,
INPUTFUNC => \&scankey,
FOREGROUND => 'white',
BACKGROUND => 'black',
SELECTEDCOL => 'green',
BORDER => 1,
BORDERCOL => 'red',
FOCUSSWITCH => "\t",
X => 1,
Y => 1,
TOPELEMENT => 0,
LISTITEMS => [@list],
});
The new method instantiates a new ListBox 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
============================================================
CAPTION undef Caption superimposed on border
CAPTIONCOL undef Foreground colour for caption text
COLUMNS 10 Number of columns displayed
LINES 3 Number of lines in the window
INPUTFUNC \&scankey Function to use to scan for keystrokes
FOREGROUND undef Default foreground colour
BACKGROUND undef Default background colour
SELECTEDCOL undef Default colour of selected items
BORDER 1 Display a border around the field
BORDERCOL undef Foreground colour for border
FOCUSSWITCH "\t" Characters which signify end of input
TOPELEMENT 0 Index of element displayed on line 1
LISTITEMS [] List of list items
MULTISEL 0 Whether or not multiple items can be
selected
TOGGLE "\n\s" What input toggles selection of the
current item
VALUE 0 or [] Index(es) of selected items
CURSORPOS 0 Index of the item the cursor is
currently on
The B<CAPTION> is only valid when the B<BORDER> is enabled. If the border
is disabled, the field will be underlined, provided the terminal supports it.
The value of B<VALUE> should be an array reference when in multiple
selection mode. Otherwise it should either undef or an integer.
=cut
sub _conf {
# Validates and initialises the new ListBox object.
#
# Usage: $self->_conf(%conf);
my $self = shift;
my %conf = (
COLUMNS => 10,
LINES => 3,
VALUE => undef,
INPUTFUNC => \&scankey,
BORDER => 1,
FOCUSSWITCH => "\t",
TOPELEMENT => 0,
LISTITEMS => [],
MULTISEL => 0,
VALUE => undef,
CURSORPOS => 0,
TOGGLE => "\n ",
@_
);
my @required = qw(X Y);
my $err = 0;
# Check for required arguments
foreach (@required) { $err = 1 unless exists $conf{$_} };
$conf{SELECTEDCOL} = lc($conf{SELECTEDCOL}) if exists $conf{SELECTEDCOL};
# Make sure no errors are returned by the parent method
$err = 1 unless $self->SUPER::_conf(%conf);
# Update VALUE depending on selection mode
$conf{VALUE} = [] if $conf{MULTISEL} and not exists $conf{VALUE};
return $err == 0 ? 1 : 0;
}
=head2 draw
$lb->draw($mwh, 1);
The draw method renders the list box 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 field's
text cursor to be rendered as well.
=cut
sub _border {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
my ($top, $pos, $lines, $cols, $items) =
@$conf{qw(TOPELEMENT CURSORPOS LINES COLUMNS LISTITEMS)};
my ($y, $x);
# Render the box
$self->SUPER::_border($dwh);
# Adjust the cursor position if it's out of whack
$pos = $#{$items} if $pos > $#{$items};
while ($pos - $top > $lines - 1) { $top++ };
while ($top > $pos) { --$top };
# Render up/down arrows as needed
$dwh->getmaxyx($y, $x);
$dwh->addch(0, $x - 2, ACS_UARROW) if $top > 0;
$dwh->addch($y - 1, $x - 2, ACS_DARROW) if
$top + $lines < @$items ;
# Restore the default settings
$self->_restore($dwh);
# Save any massaged values
@$conf{qw(TOPELEMENT CURSORPOS)} = ($top, $pos);
}
sub _content {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
my ($pos, $top, $border, $cols, $lines, $sel) =
@$conf{qw(CURSORPOS TOPELEMENT BORDER COLUMNS LINES VALUE)};
my @items = @{$$conf{LISTITEMS}};
my (@colours, $i);
# Turn on underlining (terminal-dependent) if no border is used
$dwh->attron(A_UNDERLINE) unless $border;
# Display the items on the list
if (scalar @items) {
# Display the items
for $i ($top..$#items) {
@colours = @$conf{qw(FOREGROUND BACKGROUND)};
if (defined $sel &&
grep /^$i$/, (ref($sel) eq 'ARRAY' ? @$sel : $sel)) {
# Set the colour for selected items
if (exists $$conf{SELECTEDCOL}) {
$colours[0] = $$conf{SELECTEDCOL};
$dwh->attrset(COLOR_PAIR(select_colour(
@$conf{qw(SELECTEDCOL BACKGROUND)})));
$dwh->attron(A_BOLD) if $$conf{SELECTEDCOL} eq 'yellow';
# Bold it if no selection colour was defined
} else {
$dwh->attron(A_BOLD);
}
}
# Print the item
$dwh->addstr($i - $top, 0, substr($items[$i], 0, $cols));
# Underline the line if there's no border
$dwh->chgat($i - $top, 0, $cols, A_UNDERLINE, select_colour(@colours),
0) unless $border;
# Restore the default settings
$self->_restore($dwh);
}
}
}
sub _cursor {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
my ($pos, $top, $cols, $sel) =
@$conf{qw(CURSORPOS TOPELEMENT COLUMNS VALUE)};
my $fg;
# Determine the foreground colour
if (defined $sel && exists $$conf{SELECTEDCOL} &&
grep /^$pos$/, (ref($sel) eq 'ARRAY' ? @$sel : $sel)) {
$fg = $$conf{SELECTEDCOL};
} else {
$fg = $$conf{FOREGROUND};
}
# Display the cursor
$dwh->chgat($pos - $top, 0, $cols, A_STANDOUT, select_colour(
$fg, $$conf{BACKGROUND}), 0);
# Restore the default settings
$self->_restore($dwh);
}
sub input_key {
# Process input a keystroke at a time.
#
# Usage: $self->input_key($key);
my $self = shift;
my $in = shift;
my $conf = $self->{CONF};
my $sel = $$conf{VALUE};
my @items = @{$$conf{LISTITEMS}};
my $pos = $$conf{CURSORPOS};
my $re = $$conf{TOGGLE};
my $np;
# Process special keys
if ($in eq KEY_UP) {
if ($pos > 0) {
--$pos;
} else {
beep;
}
} elsif ($in eq KEY_DOWN) {
if ($pos < $#items) {
++$pos;
} else {
beep;
}
} elsif ($in eq KEY_HOME || $in eq KEY_END || $in eq KEY_PPAGE ||
$in eq KEY_NPAGE) {
if (scalar @items) {
if ($in eq KEY_HOME) {
beep if $pos == 0;
$pos = 0;
} elsif ($in eq KEY_END) {
beep if $pos == $#items;
$pos = $#items;
} elsif ($in eq KEY_PPAGE) {
beep if $pos == 0;
$pos -= $$conf{LINES};
$pos = 0 if $pos < 0;
} elsif ($in eq KEY_NPAGE) {
beep if $pos == $#items;
$pos += $$conf{LINES};
$pos = $#items if $pos > $#items;
}
} else {
beep;
}
# Process normal key strokes
} else {
# Exit out if there's no list to apply strokes to
return unless scalar @items;
if ($in =~ /^[$re]$/) {
if ($$conf{MULTISEL}) {
if (grep /^$pos$/, @$sel) {
@$sel = grep !/^$pos$/, @$sel;
} else {
push(@$sel, $pos);
}
} else {
$sel = $pos;
}
} elsif ($in =~ /^[[:print:]]$/ && $pos < $#items) {
$pos = $self->match_key($in);
} else {
beep;
}
}
# Save the changes
@$conf{qw(VALUE CURSORPOS)} = ($sel, $pos);
}
sub match_key {
my $self = shift;
my $in = shift;
my $conf = $self->{CONF};
my @items = @{$$conf{LISTITEMS}};
my $pos = $$conf{CURSORPOS};
my $np;
$np = $pos + 1;
while ($np <= $#items && $items[$np] !~ /^\Q$in\E/i) { $np++ };
$pos = $np if $np <= $#items and $items[$np] =~ /^\Q$in\E/i;
return $pos;
}
1;
=head1 HISTORY
=over
=item 1999/12/29 -- Original list box widget in functional model
=item 2001/07/05 -- First incarnation in OO architecture
=back
=head1 AUTHOR/COPYRIGHT
(c) 2001 Arthur Corliss (corliss@digitalmages.com)
=cut