dinislage/SOAP-WSDL
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
605732b8365b48d731e1acfd6ed3127619e590c5
SOAP-WSDL/inc/perl5/site_perl/5.12.3/Curses/Widgets/TextMemo.pm

490 lines
13 KiB
Perl
Raw Blame History

# Curses::Widgets::TextMemo.pm -- Text Memo Widgets
#
# (c) 2001, Arthur Corliss <corliss@digitalmages.com>
#
# $Id: TextMemo.pm,v 1.104 2002/11/14 01:27:31 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::TextMemo - Text Memo Widgets
=head1 MODULE VERSION
$Id: TextMemo.pm,v 1.104 2002/11/14 01:27:31 corliss Exp corliss $
=head1 SYNOPSIS
use Curses::Widgets::TextMemo;
$tm = Curses::Widgets::TextMemo->new({
CAPTION => 'Memo',
CAPTIONCOL => 'blue',
COLUMNS => 10,
MAXLENGTH => undef,
LINES => 3,
MASK => undef,
VALUE => '',
INPUTFUNC => \&scankey,
FOREGROUND => 'white',
BACKGROUND => 'black',
BORDER => 1,
BORDERCOL => 'red',
FOCUSSWITCH => "\t",
CURSORPOS => 0,
TEXTSTART => 0,
PASSWORD => 0,
X => 1,
Y => 1,
READONLY => 0,
});
$tm->draw($mwh, 1);
See the Curses::Widgets pod for other methods.
=head1 REQUIREMENTS
=over
=item Curses
=item Curses::Widgets
=back
=head1 DESCRIPTION
Curses::Widgets::TextMemo provides simplified OO access to Curses-based
single line text fields. Each object maintains its own state information.
=cut
#####################################################################
#
# Environment definitions
#
#####################################################################
package Curses::Widgets::TextMemo;
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::TextMemo->new({
CAPTION => 'Memo',
CAPTIONCOL => 'blue',
COLUMNS => 10,
MAXLENGTH => undef,
LINES => 3,
MASK => undef,
VALUE => '',
INPUTFUNC => \&scankey,
FOREGROUND => 'white',
BACKGROUND => 'black',
BORDER => 1,
BORDERCOL => 'red',
FOCUSSWITCH => "\t",
CURSORPOS => 0,
TEXTSTART => 0,
PASSWORD => 0,
X => 1,
Y => 1,
READONLY => 0,
});
The new method instantiates a new TextMemo 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
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
sub _conf {
# Validates and initialises the new TextMemo object.
#
# Usage: $self->_conf(%conf);
my $self = shift;
my %conf = (
COLUMNS => 10,
MAXLENGTH => undef,
LINES => 3,
VALUE => '',
INPUTFUNC => \&scankey,
BORDER => 1,
UNDERLINE => 1,
FOCUSSWITCH => "\t",
CURSORPOS => 0,
TEXTSTART => 0,
PASSWORD => 0,
READONLY => 0,
@_
);
my @required = qw(X Y);
my $err = 0;
# Check for required arguments
foreach (@required) { $err = 1 unless exists $conf{$_} };
# Make sure no errors are returned by the parent method
$err = 1 unless $self->SUPER::_conf(%conf);
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;
}
$ts = $i > 0 ? $i : 0;
++$ts unless $pos < length($lines[0]);
} elsif ($ts + $lines - 1 < $#lines &&
$pos >= length(join('', @lines[0..($ts + $lines - 1)]))) {
$v = length(join('', @lines[0..($ts + $lines - 1)]));
$i = $ts + $lines;
until ($v >= $pos) {
$v += length($lines[$i]);
++$i;
}
$ts = $i - $lines;
++$ts if $pos == $v;
}
++$ts if $pos == length($value) and $ts + $lines == @lines;
# Save the adjust values
@$conf{qw(TEXTSTART CURSORPOS VALUE)} = ($ts, $pos, $value);
$self->{SPLIT} = [@lines];
# Render the border
if ($border) {
# Call the parent method
$self->SUPER::_border($dwh);
# Place the arrows
$dwh->getmaxyx($y, $x);
$dwh->addch(0, $x - 2, ACS_UARROW) if $ts > 0;
$dwh->addch($y - 1, $x - 2, ACS_DARROW)
if $#lines - $ts > $lines;
}
}
sub _content {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
my ($border, $ts, $pos, $lines, $cols) =
@$conf{qw(BORDER TEXTSTART CURSORPOS LINES COLUMNS)};
my @lines = @{$self->{SPLIT}};
my ($i, $j);
# Print the lines
$j = 0;
for ($i = $ts; $i < $ts + $lines; $i++) {
unless ($i > $#lines) {
$$conf{PASSWORD} ?
$dwh->addstr($j, 0, '*' x length($lines[$i])) :
$dwh->addstr($j, 0, $lines[$i]) ;
}
# 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;
while ($ts + $i < $#lines && $v + length($lines[$ts + $i]) <= $pos) {
$v += length($lines[$ts + $i]);
++$i;
}
$v = $pos - $v;
#$i-- if $i > 0 and substr($$conf{VALUE}, $pos - 1, 1) eq "\n";
if ($pos == length($$conf{VALUE}) && substr($$conf{VALUE}, $pos - 1, 1) eq
"\n") {
++$i;
$v = 0;
}
$dwh->chgat($i, $v, 1, A_STANDOUT,
select_colour(@$conf{qw(FOREGROUND BACKGROUND)}), 0);
$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 ($value, $pos, $max, $ro, $ts) =
@$conf{qw(VALUE CURSORPOS MAXLENGTH READONLY TEXTSTART)};
my @string = split(//, $value);
my @lines = @{$self->{SPLIT}};
my ($snippet, $i, $lpos, $l);
# Process special keys
if ($in eq KEY_BACKSPACE) {
return if $ro;
if ($pos > 0) {
splice(@string, $pos - 1, 1);
$value = join('', @string);
--$pos;
} else {
beep;
}
} elsif ($in eq KEY_RIGHT) {
$pos < length($value) ? ++$pos : beep;
} elsif ($in eq KEY_LEFT) {
$pos > 0 ? --$pos : beep;
} elsif ($in eq KEY_UP || $in eq KEY_DOWN ||
$in eq KEY_NPAGE || $in eq KEY_PPAGE) {
# 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;
}
$l = $ts + $i;
$lpos = $pos - $snippet;
}
# Process according to the key
if ($in eq KEY_UP) {
if ($l > 0) {
if (length($lines[$l - 1]) >= $lpos) {
$pos -= length($lines[$l - 1]);
} else {
$pos -= ($lpos + 1);
}
} else {
beep;
}
} elsif ($in eq KEY_DOWN) {
if ($l < $#lines) {
if (length($lines[$l + 1]) >= $lpos) {
$pos += length($lines[$l]);
} else {
$pos += ((length($lines[$l]) - $lpos) +
length($lines[$l + 1]) - 1);
}
} else {
beep;
}
} elsif ($in eq KEY_PPAGE) {
if ($l >= $$conf{LINES}) {
$pos -= length(join('',
@lines[(1 + $l - $$conf{LINES})..($l - 1)]));
if (length($lines[$l - $$conf{LINES}]) > $lpos) {
$pos -= length($lines[$l - $$conf{LINES}]);
} else {
$pos -= ($lpos + 1);
}
} elsif ($l > 0) {
if ($lpos > length($lines[0])) {
$pos = length($lines[0]) - 1;
} else {
$pos = $lpos;
}
} else {
beep;
}
} elsif ($in eq KEY_NPAGE) {
if ($l <= $#lines - $$conf{LINES}) {
$pos += length(join('',
@lines[($l + 1) ..($l + $$conf{LINES} - 1)]));
if (length($lines[$l + $$conf{LINES}]) >= $lpos) {
$pos += (length($lines[$l + $$conf{LINES}]) + 1);
} else {
$pos += ((length($lines[$l]) - $lpos) +
length($lines[$l + $$conf{LINES}]) - 1);
}
} elsif ($l < $#lines) {
if (length($lines[$#lines]) > $lpos) {
$pos = length($value) - (length($lines[$#lines]) -
$lpos);
} else {
$pos = length($value);
}
} else {
beep;
}
}
} elsif ($in eq KEY_HOME) {
$pos = 0;
} elsif ($in eq KEY_END) {
$pos = length($value);
# Process other keys
} else {
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
=over
=item 1999/12/29 -- Original text field 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
Reference in New Issue View Git Blame Copy Permalink