CursesWidgets
view release on metacpan or search on metacpan
# 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 - Base widget class for use with the Curses::Application
framework
=head1 MODULE VERSION
$Id: Widgets.pm,v 1.997 2002/11/14 01:30:19 corliss Exp corliss $
=head1 SYNOPSIS
use Curses::Widgets;
$rv = test_colour();
test_color();
$colpr = select_colour($fore, $back);
$colpr = select_color($fore, $back);
$key = scankey($mwh);
@lines = textwrap($text, 40);
# The following are provided for use with descendent
# classes, and while they are not expected to be
# overridden, they can be.
$obj = Curses::Widgets->new({KEY => 'value'});
$obj->_copy($href1, $href2);
$obj->reset;
$obj->input($string);
$value = $obj->getField('VALUE');
$obj->setField(
'FIELD1' => 1,
'FIELD2' => 'value'
);
$obj->execute($mwh);
$obj->draw($mwh, 1);
@geom = $obj->_geometry;
@geom = $obj->_cgeometry;
$dwh = $obj->_canvas($mwh, @geom);
$obj->_save($mwh);
$obj->_restore($mwh);
$obj->_border($mwh);
$obj->_caption
# The following are provided for use with descendent
# classes, and are expected to be overridden.
$obj->_conf(%conf);
$obj->input_key($ch);
$obj->_content($mwh);
$obj->_cursor
=head1 REQUIREMENTS
=over
=item Curses
=back
=head1 DESCRIPTION
This module serves two purposes: to provide a framework for creating
custom widget classes, and importing a few useful functions for
global use.
Widget specific methods are documented in each Widget's pod, of which the
following widgets are currently available:
=over
=item Button Set (Curses::Widgets::ButtonSet)
=item Calendar (Curses::Widgets::Calendar)
=item Combo-Box (Curses::Widgets::ComboBox)
=item Label (Curses::Widgets::Label)
=item List Box (Curses::Widgets::ListBox)
=item Multicolumn List Box (Curses::Widgets::ListBox::MultiColumn)
=item Menu (Curses::Widgets::Menu)
=item Progress Bar (Curses::Widgets::ProgressBar)
=item Text Field (Curses::Widgets::TextField)
=item Text Memo (Curses::Widgets::TextMemo)
=back
The following tutorials are available:
=over
=item Widget Usage -- General Usage & Tips (Curses::Widgets::Tutorial)
=item Widget Creation (Curses::Widgets::Tutorial::Creation)
=item Widget Creation -- ComboBox Example (Curses::Widgets::Tutorial::ComboBox)
=back
For even higher (and simpler) level control over collections of widgets on
"forms", please see B<Curses::Forms>, which uses this module as well.
=cut
#####################################################################
=head2 getField
$value = $obj->getField('VALUE');
The getField method retrieves the value(s) for every field requested
that exists in the configuration hash.
=cut
sub getField {
my $self = shift;
my @fields = @_;
my $conf = $self->{CONF};
my @results;
foreach (@fields) {
if (exists $$conf{$_}) {
push(@results, $$conf{$_});
} else {
carp ref($self), ": attempting to read a non-existent field!";
}
}
return scalar @results > 1 ? @results : $results[0];
}
=head2 setField
$obj->setField(
'FIELD1' => 1,
'FIELD2' => 'value'
);
The setField method sets the value for every key/value pair passed.
=cut
sub setField {
my $self = shift;
my %fields = (@_);
my $conf = $self->{CONF};
foreach (keys %fields) {
if (exists $$conf{$_}) {
$$conf{$_} = $fields{$_};
} else {
carp ref($self), ": attempting to set a non-existent field!";
}
}
}
=head2 draw
$obj->draw($mwh, 1);
The draw method can be overridden in each descendant class. It
is reponsible for the rendering of the widget, and only that. The first
argument is mandatory, being a valid window handle with which to create
the widget's derived window. The second is optional, but if set to
true, will tell the widget to draw itself in an 'active' state. For
instance, the TextField widget will also render a cursor, while a
ButtonSet widget will render the selected button in standout mode.
The rendering sequence defined in this class is as follows:
# Get the canvas geometry and create a window handle to it
$dwh = $self->_canvas($mwh, $self->_geometry);
return 0 unless $dwh;
$self->_init($dwh);
$self->_border($dwh);
$self->_caption($dwh);
# Get the content area geometry and create a window handle to it
$cwh = $self->_canvas($dwh, $self->_cgeometry);
unless (defined $cwh) {
$dwh->delwin;
return 0;
}
$self->_content($cwh);
$self->_cursor($cwh) if $active;
=cut
sub draw {
my $self = shift;
my $mwh = shift;
my $active = shift;
my (@geom, $dwh, $cwh);
# Get the canvas geometry and create a window handle to it
$dwh = $self->_canvas($mwh, $self->_geometry);
return 0 unless $dwh;
$self->_init($dwh);
$self->_border($dwh);
$self->_caption($dwh);
# Get the content area geometry and create a window handle to it
$cwh = $self->_canvas($dwh, $self->_cgeometry);
unless (defined $cwh) {
$dwh->delwin;
return 0;
}
$self->_content($cwh);
$self->_cursor($cwh) if $active;
# Flush the changes to the screen and release the window handles
$cwh->refresh;
$cwh->delwin;
$dwh->refresh;
$dwh->delwin;
return 1;
}
=head2 _geometry
@geom = $obj->_geometry;
This method returns the size of the canvas, with dimensions adjusted to
account for a border (based on the value of B<BORDER> in the configuration
hash).
=cut
sub _geometry {
my $self = shift;
my $conf = $self->{CONF};
my @rv;
@rv = @$conf{qw(LINES COLUMNS Y X)};
if ($$conf{BORDER}) {
$rv[0] += 2;
$rv[1] += 2;
}
return @rv;
}
=head2 _cgeometry
@geom = $obj->_cgeometry;
This method returns the size of the content area. The Y and X coordinates are
adjusted appropriately for rendering in a widget canvas. (0, 0) is returned
for widgets with no border, and (1, 1) is returned for widgets with a border
(based on the value of B<BORDER> in the configuration hash).
=cut
sub _cgeometry {
my $self = shift;
my $conf = $self->{CONF};
my @rv;
@rv = (@$conf{qw(LINES COLUMNS)}, 0, 0);
@rv[2,3] = (1, 1) if $$conf{BORDER};
return @rv;
}
=head2 _canvas
$dwh = $obj->_canvas($mwh, @geom);
within the configuration hash.
=cut
sub _border {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
if ($$conf{BORDER}) {
$dwh->attrset(COLOR_PAIR(
select_colour(@$conf{qw(BORDERCOL BACKGROUND)})));
$dwh->attron(A_BOLD) if $$conf{BORDERCOL} eq 'yellow';
$dwh->box(ACS_VLINE, ACS_HLINE);
$self->_restore($dwh);
}
}
=head2 _caption
$obj->_caption
This method draws a caption on the first line of the passed window if
B<CAPTION> is defined within the configuration hash.
=cut
sub _caption {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
if (defined $$conf{CAPTION}) {
$dwh->attrset(COLOR_PAIR(
select_colour(@$conf{qw(CAPTIONCOL BACKGROUND)})));
$dwh->attron(A_BOLD) if $$conf{CAPTIONCOL} eq 'yellow';
$dwh->addstr(0, 1, substr($$conf{CAPTION}, 0, $$conf{COLUMNS}));
$self->_restore($dwh);
}
}
=head2 _content
$obj->_content($mwh);
This method should be overridden in all descendent classes, and should render
any content in the passed window. The B<draw> method, as defined in this
class, will pass a window the exact size of the content area, so no
adjustments will need to be made to accomodate a border.
=cut
sub _content {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
# Override this method to render widget content
}
=head2 _cursor
$obj->_cursor
This method should be overriden in all descendent classes that display a
cursor in the content area. The B<draw> method, as defined in this class,
calls this method after the content is rendered, and passes it a window handle
the exact size of the content area.
=cut
sub _cursor {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
# Override this method to render widget cursor
}
1;
=head1 HISTORY
=over
=item 2001/07/05 -- First implementation of the base class.
=back
=head1 AUTHOR/COPYRIGHT
(c) 2001 Arthur Corliss (corliss@digitalmages.com)
=cut
( run in 0.399 second using v1.01-cache-2.11-cpan-39bf76dae61 )