CursesWidgets
view release on metacpan or search on metacpan
----------------------------
revision 1.997 locked by: corliss;
date: 2002/11/14 01:30:19; author: corliss; state: Exp; lines: +34 -7
--POD fixes
--Compatibility fix for curses without attr_get/attr_set functions
--Introduction of the multi-column list box
ListBox:
--Fixed VALUE initialisation bug when when in multi-select mode
--Fixed cursor position bug for large jumps down the last (past the
viewable window)
--Changed arrow placement to go by window bounds to make inherited
behaviour more predictable
--Added printable character navigation (thanks to Eric Lenio)
Menu:
--Checking for defined code reference before attempting to execute
TextMemo:
--Changed arrow placement to go by window bounds to make inherited
behaviour more predictable
----------------------------
--Added test_colour function
--Added DEFAULTFG and DEFAULTBG scalars
--Removed hard coded black:white colour pair, now detecting
actual colours
--select_colour now correctly applies terminal default bg colour
rather than black
--select_colour now accepts any case of colour strings
--_conf method now applies terminal defaults to all standard
colour keys
--draw method is now a standard handler for all widgets,
content printing is now done in _content and _cursor
--Border and captions are handled by default in Widgets.pm now,
with _border and _caption
--Content is now drawn in it's own private derived window,
removing any need to adjust coordinates for a border
--Added _geometry, _cgeometry, and _canvas methods
--Added _save and _restore to save the window default colours and
attributes
--Fixed a few bugs in how textwrap handled and returned trailing
newlines
--Changed LENGTH attribute to COLUMNS in applicable widgets
--Removed touchwin calls for more efficient refresh
--Newlines no longer count as a character space in textwrap
All Widgets:
--Removed undef colour keys
--Reworked to work with new Widgets.pm internals
Calendar:
--Added header colour selection support
--VALUE now holds the date the cursor is on in the current calendar
ComboBox:
--Fixed bug to allow a user not to select something from the list
ListBox:
--Entire widget is now underlined correctly in non-borderd mode
--VALUE now holds selected items instead of SELECTED
TextField & TextMemo:
--Fixed underline mode to correctly underline entire field, instead
of just text
--Added regex to accept only printable characters as part of the value
--Fixed bugs in cursor placement and scrolling
----------------------------
revision 1.995 locked by: corliss;
date: 2002/10/22 18:00:23; author: corliss;
--Added Menu and Label widgets
--Auto-applying the list length based on list entries was getting lost
at times in the ComboBox. Fixed.
--Popup wouldn't show up in the right location on combos on newwins that
didn't start at 0,0. Fixed.
--VALUE in ListBox wasn't getting updated. Fixed.
----------------------------
$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
=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
$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;
}
=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.
Widgets/ButtonSet.pm view on Meta::CPAN
sub _content {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
my ($hz, $value, $length) = @$conf{qw(HORIZONTAL VALUE LENGTH)};
my @labels = @{$$conf{LABELS}};
my ($i, $j, $l, $offset);
my $z = 0;
# Enforce a sane cursor position
if ($$conf{VALUE} > $#labels) {
$$conf{VALUE} = $#labels;
} elsif ($$conf{VALUE} < 0) {
$$conf{VALUE} = 0;
}
# Calculate the cell offset
$offset = $$conf{BORDER} ? 1 : ($$conf{PADDING} ? $$conf{PADDING} : 0);
# Draw the labels
Widgets/ButtonSet.pm view on Meta::CPAN
if ($hz) {
$dwh->addstr(0, $z + $i, $_);
$z += $offset + $length;
} else {
$dwh->addstr($z, $i, $_);
$z += $offset + 1;
}
}
}
sub _cursor {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
my $label = $$conf{LABELS}->[$$conf{VALUE}];
my ($length, $hz) = @$conf{qw(LENGTH HORIZONTAL)};
my ($y, $x) = (0, 0);
my ($offset);
# Calculate the cell offset
$offset = $$conf{BORDER} ? 1 : ($$conf{PADDING} ? $$conf{PADDING} : 0);
# Set the coordinates
if ($hz) {
$offset = $$conf{VALUE} ? $$conf{VALUE} * $length + $$conf{VALUE} *
$offset : 0;
$x = $offset;
} else {
$offset = $$conf{VALUE} ? $$conf{VALUE} + $$conf{VALUE} * $offset : 0;
$y = $offset;
}
# Display the cursor
$dwh->chgat($y, $x, $length, A_STANDOUT,
select_colour(@$conf{qw(FOREGROUND BACKGROUND)}), 0);
# Restore the default settings
$self->_restore($dwh);
}
sub input_key {
# Process input a keystroke at a time.
#
Widgets/Calendar.pm view on Meta::CPAN
INPUTFUNC \&scankey Function to use to scan for keystrokes
FOREGROUND undef Default foreground colour
BACKGROUND undef Default background colour
BORDER 1 Display a border around the field
BORDERCOL undef Foreground colour for border
FOCUSSWITCH "\t" Characters which signify end of input
HIGHLIGHT [] Days to highlight
HIGHLIGHTCOL undef Default highlighted data colour
HEADERCOL undef Default calendar header colour
MONTH (current) Month to display
VALUE 1 Day of the month where the cursor is
ONYEAR undef Callback function triggered by year
ONMONTH undef Callback function triggered by month
ONDAY undef Callback function triggered by day
Each of the ON* callback functions expect a subroutine reference that excepts
one argument: a handle to the calendar object itself. If more than one
trigger is called, it will be called in the order of day, month, and then
year.
=cut
Widgets/Calendar.pm view on Meta::CPAN
$i = 0;
foreach (@cal) {
# Set the header colour (if defined)
unless ($i > 1 || ! exists $$conf{HEADERCOL}) {
$dwh->attrset(COLOR_PAIR(
select_colour(@$conf{qw(HEADERCOL BACKGROUND)})));
$dwh->attron(A_BOLD) if $$conf{HEADERCOL} eq 'yellow';
}
# Save the cursor position if it's on this line
$self->{COORD} = [$i, length($1)] if $cal[$i] =~ /^(.*\b)$pos\b/;
# Print the calendar line
$dwh->addstr($i, 0, $cal[$i]);
# Highlight the necessary dates
if (exists $$conf{HIGHLIGHTCOL}) {
until ($#highlight == -1 || $cal[$i] !~ /^(.*\b)$highlight[0]\b/) {
$dwh->chgat($i, length($1), length($highlight[0]), 0,
select_colour(@$conf{qw(HIGHLIGHTCOL BACKGROUND)}), 0);
Widgets/Calendar.pm view on Meta::CPAN
}
}
# Restore the default settings (if adjusted for headers or hightlights)
$self->_restore($dwh);
++$i;
}
}
sub _cursor {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
my $pos = $$conf{VALUE};
my @highlight = @{$$conf{HIGHLIGHT}};
my ($y, $x) = @{$self->{COORD}};
my $fg;
# Determine the foreground colour
if (exists $$conf{HIGHLIGHTCOL}) {
$fg = (grep /^$pos$/, @highlight) ? $$conf{HIGHLIGHTCOL} :
$$conf{FOREGROUND};
} else {
$fg = $$conf{FOREGROUND};
}
# Display the cursor
$dwh->chgat($y, $x, length($pos), A_STANDOUT,
select_colour($fg, $$conf{BACKGROUND}), 0);
# Restore the default settings
$self->_restore($dwh);
}
sub _gen_cal {
# Generates the calendar month output, and stuffs it into a
# LOL, which is returned by the method.
Widgets/Calendar.pm view on Meta::CPAN
} elsif ($in eq KEY_HOME || $in eq KEY_FIND) {
($pos, @date) = (localtime)[3..5];
$date[0] += 1;
$date[1] += 1900;
# Key press wasn't a navigation key, so reset trigger
} else {
$trigger = '';
}
# Adjust the dates as necessary according to the cursor movement
if ($pos < 1) {
--$date[0];
if ($date[0] < 1) {
--$date[1];
$date[0] = 12;
}
$pos += $days[$date[0]];
} elsif ($pos > $days[$date[0]]) {
++$date[0];
if ($date[0] > 12) {
Widgets/ComboBox.pm view on Meta::CPAN
COLUMNS 10 Number of columns displayed
MAXLENGTH 255 Maximum string length allowed
MASK undef Not yet implemented
VALUE '' Current field text
INPUTFUNC \&scankey Function to use to scan for keystrokes
FOREGROUND undef Default foreground colour
BACKGROUND undef Default background colour
BORDER 1 Display a border around the field
BORDERCOL undef Foreground colour for border
FOCUSSWITCH "\t\n" Characters which signify end of input
CURSORPOS 0 Starting position of the cursor
TEXTSTART 0 Position in string to start displaying
PASSWORD 0 Subsitutes '*' instead of characters
READONLY 0 Prevents alteration to content
LISTLINES 5 Number of lines to display at a time
in the drop-down list
LISTCOLUMNS[COLUMNS] Width of the drop-down list. Defaults
to the same length specified for the
CombBox widget
LISTITEMS [] Items listed in drop-down list
Widgets/ComboBox.pm view on Meta::CPAN
return $err == 0 ? 1 : 0;
}
=head2 draw (inherited from Curses::Widgets::TextField)
$cb->draw($mwh, 1);
The draw method renders the text field 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 _geometry {
my $self = shift;
my $conf = $self->{CONF};
my @rv = @$conf{qw(LINES COLUMNS Y X)};
if ($$conf{BORDER}) {
$rv[0] += 2;
Widgets/ComboBox.pm view on Meta::CPAN
# Call the parent draw
return $self->SUPER::draw($mwh, $active);
}
=head2 popup
$combo->popup;
This method causes the drop down list to be displayed. Since, theoretically,
this list 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 BORDER)};
my ($by, $bx) = @{$self->{BEGYX}};
my $lb = $self->{LISTBOX};
my ($pwh, $items, $cp, $in, $key);
Widgets/ListBox.pm view on Meta::CPAN
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
Widgets/ListBox.pm view on Meta::CPAN
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 ;
Widgets/ListBox.pm view on Meta::CPAN
# 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.
#
Widgets/ListBox/MultiColumn.pm view on Meta::CPAN
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 _geometry {
my $self = shift;
my $conf = $self->{CONF};
my @rv;
@rv = $self->SUPER::_geometry;
if (@{$$conf{HEADERS}}) {
Widgets/Menu.pm view on Meta::CPAN
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 {
Widgets/Menu.pm view on Meta::CPAN
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);
Widgets/Menu.pm view on Meta::CPAN
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);
Widgets/TextField.pm view on Meta::CPAN
COLUMNS 10 Number of columns displayed
MAXLENGTH 255 Maximum string length allowed
MASK undef Not yet implemented
VALUE '' Current field text
INPUTFUNC \&scankey Function to use to scan for keystrokes
FOREGROUND undef Default foreground colour
BACKGROUND undef Default background colour
BORDER 1 Display a border around the field
BORDERCOL undef Foreground colour for border
FOCUSSWITCH "\t\n" Characters which signify end of input
CURSORPOS 0 Starting position of the cursor
TEXTSTART 0 Position in string to start displaying
PASSWORD 0 Subsitutes '*' instead of characters
READONLY 0 Prevents alteration to content
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.
If B<MAXLENGTH> is undefined, no limit will be placed on the string length.
If B<BORDER> is true, the widget will be enlarged to three columns and two
Widgets/TextField.pm view on Meta::CPAN
return $err == 0 ? 1 : 0;
}
=head2 draw
$tf->draw($mwh, 1);
The draw method renders the text field 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 _content {
my $self = shift;
my $dwh = shift;
my $cursor = shift;
my $conf = $self->{CONF};
my ($pos, $ts, $value, $border, $col) =
@$conf{qw(CURSORPOS TEXTSTART VALUE BORDER COLUMNS)};
my $seg;
# Trim the value if it exceeds the maximum length
$value = substr($value, 0, $$conf{MAXLENGTH}) if $$conf{MAXLENGTH};
# Turn on underlining (terminal-dependent) if no border is used
$dwh->attron(A_UNDERLINE) unless $border;
# Adjust the cursor position and text start if it's out of whack
if ($pos > length($value)) {
$pos = length($value);
} elsif ($pos < 0) {
$pos = 0;
}
if ($pos > $ts + $$conf{COLUMNS} - 1) {
$ts = $pos + 1 - $$conf{COLUMNS};
} elsif ($pos < $ts) {
$ts = $pos;
}
Widgets/TextField.pm view on Meta::CPAN
$seg = substr($value, $ts, $$conf{COLUMNS});
$seg = '*' x length($seg) if $$conf{PASSWORD};
$seg .= ' ' x ($$conf{COLUMNS} - length($seg));
$dwh->addstr(0, 0, $seg);
$dwh->attroff(A_BOLD);
# Underline the field if no border is used
$dwh->chgat(0, 0, $col, A_UNDERLINE,
select_colour(@$conf{qw(FOREGROUND BACKGROUND)}), 0) unless $border;
# Save the textstart, cursorpos, and value in case it was tweaked
@$conf{qw(TEXTSTART CURSORPOS VALUE)} = ($ts, $pos, $value);
}
sub _cursor {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
# Display the cursor
$dwh->chgat(0, $$conf{CURSORPOS} - $$conf{TEXTSTART}, 1, A_STANDOUT,
select_colour(@$conf{qw(FOREGROUND BACKGROUND)}), 0)
unless $$conf{READONLY};
# Restore the default settings
$self->_restore($dwh);
}
sub input_key {
# Process input a keystroke at a time.
Widgets/TextField.pm view on Meta::CPAN
return if $ro || $in !~ /^[[:print:]]$/;
# Exit if it's a non-printing character
return unless $in =~ /^[\w\W]$/;
# Reject if we're already at the max length
if (defined $max && length($value) == $max) {
beep;
return;
# Append to the end if the cursor's at the end
} elsif ($pos == length($value)) {
$value .= $in;
# Insert the character at the cursor's position
} elsif ($pos > 0) {
@string = (@string[0..($pos - 1)], $in, @string[$pos..$#string]);
$value = join('', @string);
# Insert the character at the beginning of the string
} else {
$value = "$in$value";
}
# Increment the cursor's position
++$pos;
}
# Save the changes
@$conf{qw(VALUE CURSORPOS)} = ($value, $pos);
}
1;
=head1 HISTORY
Widgets/TextMemo.pm view on Meta::CPAN
COLUMNS 10 Number of columns displayed
MAXLENGTH undef Maximum string length allowed
LINES 3 Number of lines in the window
VALUE '' Current field text
INPUTFUNC \&scankey Function to use to scan for keystrokes
FOREGROUND undef Default foreground colour
BACKGROUND undef Default background colour
BORDER 1 Display a border around the field
BORDERCOL undef Foreground colour for border
FOCUSSWITCH "\t" Characters which signify end of input
CURSORPOS 0 Starting position of the cursor
TEXTSTART 0 Line number of string to start
displaying
PASSWORD 0 Subsitutes '*' instead of characters
READONLY 0 Prevents alteration to content
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 B<MAXLENGTH> has no effect if left undefined.
=cut
Widgets/TextMemo.pm view on Meta::CPAN
return $err == 0 ? 1 : 0;
}
=head2 draw
$tm->draw($mwh, 1);
The draw method renders the text memo 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 ($border, $ts, $pos, $value, $lines) =
@$conf{qw(BORDER TEXTSTART CURSORPOS VALUE LINES)};
my (@lines, $v, $i, $y, $x);
# Massage the value as needed, and split the result
$value = '' unless defined $value;
$value = substr($value, 0, $$conf{MAXLENGTH}) if
defined $$conf{MAXLENGTH};
@lines = textwrap($value, $$conf{COLUMNS} - 1);
# Adjust the cursor position and text start line if they're out of whack
$pos = $pos < 0 ? 0 : ($pos > length($value) ? $pos = length($value) :
$pos);
$ts = $#lines if $ts > $#lines;
$ts = 0 if $ts < 0;
if ($ts > 0 && $pos < length(join('', @lines[0..($ts - 1)]))) {
$v = length(join('', @lines[0..($ts - 1)]));
$i = $ts - 1;
until ($v <= $pos) {
$v -= length($lines[$i]);
--$i;
Widgets/TextMemo.pm view on Meta::CPAN
}
# Underline each line if there's no border
$dwh->chgat($j, 0, $cols, A_UNDERLINE,
select_colour(@$conf{qw(FOREGROUND BACKGROUND)}), 0) unless $border;
$j++;
}
}
sub _cursor {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
my ($pos, $ts) = @$conf{qw(CURSORPOS TEXTSTART)};
my @lines = @{$self->{SPLIT}};
my $i = 0;
my $v = 0;
my $seg;
$v = length(join('', @lines[0..($ts - 1)])) if $ts > 0;
Widgets/TextMemo.pm view on Meta::CPAN
# Exit early if there's no text
unless (length($value) > 0) {
beep;
return;
}
# Get the text length up to the displayed window
$snippet = $ts == 0 ? 0 : length(join('', @lines[0..($ts - 1)]));
# Get the position of the cursor relative to the line it's on,
# as well as the line index
if ($pos == length($value)) {
$l = $#lines;
$lpos = length($lines[$#lines]);
} else {
$i = 0;
while ($snippet + length($lines[$ts + $i]) <= $pos) {
$snippet += length($lines[$ts + $i]);
++$i;
}
Widgets/TextMemo.pm view on Meta::CPAN
return if $ro || $in !~ /^[[:print:]]$/;
# Exit if it's a non-printing character
return unless $in =~ /^[\w\W]$/;
# Reject if we're already at the max length
if (defined $max && length($value) == $max) {
beep;
return;
# Append to the end if the cursor's at the end
} elsif ($pos == length($value)) {
$value .= $in;
# Insert the character at the cursor's position
} elsif ($pos > 0) {
@string = (@string[0..($pos - 1)], $in, @string[$pos..$#string]);
$value = join('', @string);
# Insert the character at the beginning of the string
} else {
$value = "$in$value";
}
# Increment the cursor's position
++$pos;
}
# Save the changes
@$conf{qw(VALUE CURSORPOS TEXTSTART)} = ($value, $pos, $ts);
}
1;
=head1 HISTORY
Widgets/Tutorial.pod view on Meta::CPAN
routines that I want to run while waiting for input. If you're comfortable
with that, you can do the same:
halfdelay(5);
Next, I turned on cooked input, since the widgets make heavy use of constants
for recognising special keys:
$mwh->keypad(1);
Finally, we set the cursor visibility to invisible, since the widgets will
provide their own as necessary:
curs_set(0);
From this point, we're not ready to start splashing widgets to the screen and
start handling input.
=head1 USAGE INSTRUCTIONS
=head2 BASIC USAGE
Widgets/Tutorial.pod view on Meta::CPAN
borders on by default, the actual number of columns and lines that will be
used by the above widget is 10 and 3, respectively.
To cause the widget to display itself, call the B<draw> method:
$tf->draw($mwh, 0);
The first argument is a handle to the window in which you want the widget to
draw itself. All widgets are drawn in derived windows. The second argument
should be a Perlish boolean value which instructs the draw method whether or
not to draw the cursor.
When you're ready to accept input, the simplest method is to use the
B<execute> method:
$tf->execute($mwh);
This method is a blocking call until the widget is fed a character matching
the class defined by FOCUSSWITCH ([\n\t] by default). Until it recieves a
matching character, the widget will respond appropriately to all user input
and update the display automatically.
Widgets/Tutorial/Creation.pod view on Meta::CPAN
Creating a custom widget is as easy as creating a descendant class of
B<Curses::Widget> and defining as few as four methods:
Method Purpose
====================================================
_conf Validates configurations options and
initialises the internal state/data
_content Renders the widget according to the
current state
_cursor Renders the widget cursor according to the
current state
input_key Updates the state information according
to the passed character input
=head2 BASIC MODULE STRUCTURE
A decent code template for custom widgets would start with the following
(we'll call our new widget B<MyWidget>):
package MyWidget;
Widgets/Tutorial/Creation.pod view on Meta::CPAN
The argument will be a window handle to the I<content area> of the widget.
You should always layout your widget with the upper left corner as (0, 0),
since the B<draw> method is responsible for allocating any extra space needed
for borders and captions.
If your widget doesn't support borders and/or captions you can do one of two
things: override those methods (B<_border> and B<_caption>) to immediately
return without doing anything, or override the B<draw> method to exclude those
calls. Typically, the former method of handling this would be preferred.
The third method you need to override is the B<_cursor> method. This accepts
the same window handle as the B<_content> method. The default B<draw> method
will only call this method if it was called with a true I<active> argument.
Neither of these two methods will need to allocate, refresh, or destroy window
handles, just print the content. The windows will already be erased and
initialised to specified foreground/background pairs, and those settings saved
via the B<_save> method. If at any time you need to reset the window handle's
current cursor back to those settings you can call B<_restore>:
$self->_restore($dwh);
In fact, in order to make the state of the window handle more predictable for
descendent classes you should probably call _restore at the end of each of
these methods.
The final method that should be overridden is the input_key method. This
expects a single argument, that being the keystroke captured by the keyboard
scanning function. It uses that value to update (if it's not rejected) the
( run in 0.323 second using v1.01-cache-2.11-cpan-4d50c553e7e )