Curses-UI
view release on metacpan or search on metacpan
lib/Curses/UI/Widget.pm view on Meta::CPAN
# ----------------------------------------------------------------------
# Curses::UI::Widget
#
# (c) 2001-2002 by Maurice Makaay. All rights reserved.
# This file is part of Curses::UI. Curses::UI is free software.
# You can redistribute it and/or modify it under the same terms
# as perl itself.
#
# Currently maintained by Marcus Thiesen
# e-mail: marcus@cpan.thiesenweb.de
# ----------------------------------------------------------------------
package Curses::UI::Widget;
use strict;
use Carp qw(confess);
use Term::ReadKey;
use Curses;
use Curses::UI::Common;
require Exporter;
use vars qw(
$VERSION
@ISA
@EXPORT
);
$VERSION = '1.12';
@ISA = qw(
Curses::UI::Common
Exporter
);
@EXPORT = qw(
height_by_windowscrheight
width_by_windowscrwidth
process_padding
loose_focus
lose_focus
);
sub new ()
{
my $class = shift;
my %userargs = @_;
keys_to_lowercase(\%userargs);
my %args = (
-parent => undef, # the parent object
-x => 0, # horizontal position (rel. to -parent)
-y => 0, # vertical position (rel. to -parent)
-width => undef, # horizontal size
-height => undef, # vertical size
-border => 0, # add a border?
-sbborder => 0, # add square bracket border?
-nocursor => 0, # Show a cursor?
-titlefullwidth => 0, # full width for title?
-titlereverse => 1, # reverse chars for title?
-title => undef, # A title to add to the widget (only for
# -border = 1)
# padding outside widget
-pad => undef, # all over padding
-padright => undef, # free space on the right side
-padleft => undef, # free space on the left side
-padtop => undef, # free space above
-padbottom => undef, # free space below
# padding inside widget
-ipad => undef, # all over padding
-ipadright => undef, # free space on the right side
-ipadleft => undef, # free space on the left side
-ipadtop => undef, # free space above
-ipadbottom => undef, # free space below
# scrollbars
-vscrollbar => 0, # vert. scrollbar (top/bottom)
-vscrolllen => 0, # total number of rows
-vscrollpos => 0, # current row position
-hscrollbar => 0, # hor. scrollbar (left/right)
-hscrolllen => 0, # total number of columns
-hscrollpos => 0, # current column position
-onfocus => undef, # onFocus event handler
-onblur => undef, # onBlur event handler
-intellidraw => 1, # Support intellidraw()?
-focusable => 1, # This widget can get focus
-htmltext => 1, # Recognize HTML tags in drawn text
#user data
-userdata => undef, #user internal data
#color
# Border
-bfg => -1,
-bbg => -1,
# Scrollbar
-sfg => -1,
-sbg => -1,
# Titlebar
-tfg => -1,
-tbg => -1,
%userargs,
-focus => 0, # has the widget focus?
);
# Allow the value -1 for using the full width and/or
# height for the widget.
$args{-width} = undef
if defined $args{-width} and $args{-width} == -1;
$args{-height} = undef
if defined $args{-height} and $args{-height} == -1;
&Curses::UI::fatalerror(
"Missing or illegal parameter: -parent\n"
lib/Curses/UI/Widget.pm view on Meta::CPAN
}
} else {
$binding = $this->{-bindings}->{$key};
if (not defined $binding) {
# Check for default routine.
$binding = $this->{-bindings}->{''};
}
}
if (defined $binding) {
my $return = $this->do_routine($binding, $key, @extra);
# Redraw if draw schedule is set.
$this->intellidraw if $this->schedule_draw;
return $return;
} else {
return 'DELEGATE';
}
}
sub do_routine($;$)
{
my $this = shift;
my $binding = shift;
my @arguments = @_;
# Find the routine to call.
my $routine = $this->{-routines}->{$binding};
if (defined $routine)
{
if (ref $routine eq 'CODE') {
my $return = $routine->($this, @arguments);
return $return;
} else {
return $routine;
}
} else {
$this->root->fatalerror(
"No routine defined for keybinding \"$binding\"!"
);
}
}
sub onFocus($;$) { shift()->set_event('-onfocus', shift()) }
sub onBlur($;$) { shift()->set_event('-onblur', shift()) }
sub event_onfocus()
{
my $this = shift;
# Let the parent find another widget to focus
# if this widget is not focusable.
unless ($this->focusable) {
return $this->parent->focus($this);
}
$this->{-focus} = 1;
$this->run_event('-onfocus');
# Set cursor mode
my $show_cursor = $this->{-nocursor} ? 0 : 1;
$this->root->cursor_mode($show_cursor);
$this->draw(1) if (not $this->root->overlapping);
return $this;
}
sub event_onblur()
{
my $this = shift;
$this->{-focus} = 0;
$this->run_event('-onblur');
$this->draw(1) if (not $this->root->overlapping);
return $this;
}
sub event_keypress($;)
{
my $this = shift;
my $key = shift;
$this->process_bindings($key);
}
sub event_mouse($;)
{
my $this = shift;
my $MEVENT = shift;
my $winp = $this->windowparameters;
my $abs_x = $MEVENT->{-x} - $winp->{-x};
my $abs_y = $MEVENT->{-y} - $winp->{-y};
$this->process_bindings($MEVENT, 1, $abs_x, $abs_y);
}
sub mouse_button1($$$$;)
{
my $this = shift;
my $event = shift;
my $x = shift;
my $y = shift;
$this->focus() if not $this->{-focus} and $this->focusable;
}
# ----------------------------------------------------------------------
# Event handling
# ----------------------------------------------------------------------
sub clear_event($;)
{
my $this = shift;
my $event = shift;
$this->set_event($event, undef);
return $this;
}
sub set_event($;$)
{
my $this = shift;
my $event = shift;
lib/Curses/UI/Widget.pm view on Meta::CPAN
# In case of a very simple widget, this will only mean
# that the Widget has to be layouted (in which case the
# routine could be left out, since it's in the base
# class already). In other cases you will have to add
# your own layout code. This routine is very important,
# since it will enable the resizeability of the widget!
#
sub layout () {
my $this = shift;
$this->SUPER::layout;
return $this if $Curses::UI::screen_too_small;
....your own layout stuff....
# If you decide that the widget does not fit on the
# screen, then set $Curses::UI::screen_too_small
# to a true value and return.
if ( ....the widget does not fit.... ) {
$Curses::UI::screen_too_small++;
return $this;
}
return $this;
}
# The widget is drawn by the draw() routine. The
# $no_update part is used to disable screen flickering
# if a lot of widgets have to be drawn at once (for
# example on resizing or redrawing). The curses window
# which you can use for drawing the widget's contents
# is $this->{-canvasscr}.
#
sub draw(;$) {
my $this = shift;
my $no_doupdate = shift || 0;
return $this if $this->hidden;
$this->SUPER::draw(1);
....your own draw stuff....
$this->{-canvasscr}->addstr(0, 0, "Fixed string");
....your own draw stuff....
$this->{-canvasscr}->noutrefresh;
doupdate() unless $no_doupdate;
return $this;
}
# Focus the widget. If you do not override this routine
# from Curses::UI::Widget, the widget will not be
# focusable. Mostly you will use the generic_focus() method.
#
sub focus()
{
my $this = shift;
$this->show; # makes the widget visible if it was invisible
return $this->generic_focus(
undef, # delaytime, default = 2 (1/10 second).
NO_CONTROLKEYS, # disable controlkeys like CTRL+C. To enable
# them use CONTROLKEYS instead.
CURSOR_INVISIBLE, # do not show the cursor (if supported). To
# show the cursor use CURSOR_VISIBLE.
\&pre_key_routine, # optional callback routine to execute
# before a key is read. Mostly unused.
);
}
....your own widget handling routines....
=head1 SEE ALSO
L<Curses::UI|Curses::UI>
=head1 AUTHOR
Copyright (c) 2001-2002 Maurice Makaay. All rights reserved.
Maintained by Marcus Thiesen (marcus@cpan.thiesenweb.de)
This package is free software and is provided "as is" without express
or implied warranty. It may be used, redistributed and/or modified
under the same terms as perl itself.
( run in 0.703 second using v1.01-cache-2.11-cpan-39bf76dae61 )