--- ISelect.pm 2007/10/25 15:50:56 12
+++ ISelect.pm 2007/10/25 18:39:49 15
@@ -7,7 +7,18 @@
use Carp qw/cluck confess/;
use Data::Dump qw/dump/;
-our $VERSION = '0.00';
+use base qw/Class::Accessor/;
+__PACKAGE__->mk_accessors( qw/
+screen
+lines
+error_text
+status_text
+
+debug
+/ );
+
+
+our $VERSION = '0.01';
=head1 NAME
@@ -15,132 +26,202 @@
=head1 METHODS
-=cut
+=head2 new
+
+ my $iselect = Term::ISelect->new({
+ lines => [
+ 'first line',
+ '{s}second selectable line',
+ '',
+ 'last line',
+ ],
+ debug => 1
+ });
+
+=head2 open_screen
+
+ $iselect->open_screen;
-my $scr;
+=cut
# leave sane terminal if script dies
$SIG{__DIE__} = sub {
eval { system('stty sane'); };
};
-my @lines;
+sub open_screen {
+ my $self = shift;
+ $self->screen( new Term::Screen );
+}
my $top_screen_line = 0; # offset in original text
my $pos = 0;
# default: select first line
my $sel_pos = 0;
-my $status_text = '';
-my $error_text = '';
my $status_lines = 3;
my $selectable_line;
+my $nr_lines = 0;
+
+=head2 full_line
+
+Returns line padded up to screen width
+
+ $iselect->full_line( "foo bar" );
+
+=cut
+
sub full_line {
+ my $self = shift;
+
+ my $cols = $self->screen->cols;
+
my $t = shift;
$t = '' unless defined $t;
- return $t . (" " x ($scr->cols - length($t)));
+ $t = substr($t,0,$cols) if length($t) > $cols;
+ return $t . (" " x ($cols - length($t)));
}
-sub chunk {
- my $t = shift;
- cluck "expected line" unless defined $t;
- return substr($t,0,$scr->cols);
-}
+
+=head2 redraw_line
+
+ $iselect->redraw_line( $line_on_screen, $content_of_line );
+
+=cut
sub redraw_line {
+ my $self = shift;
+
my ($l,$line) = @_;
if ( defined $selectable_line->{ $l + $top_screen_line } ) {
- $scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();
+ $self->screen->at($l,0)->bold()->puts( $self->full_line( $line ) )->normal();
} else {
- $scr->at($l,0)->puts( full_line( chunk($line) ) );
+ $self->screen->at($l,0)->puts( $self->full_line( $line ) )
}
}
-sub redraw {
- for my $l (0 .. $scr->rows - $status_lines) {
+=head2 redraw_screen
+
+ $iselect->redraw_screen
+
+=cut
+
+sub redraw_screen {
+ my $self = shift;
+ my @lines = @{ $self->lines };
+ $nr_lines = $#lines;
+ for my $l (0 .. $self->screen->rows - $status_lines) {
my $line = $lines[ $l + $top_screen_line ];
- redraw_line( $l, $line );
+ $self->redraw_line( $l, $line );
last if ($l == $#lines);
}
- selected(0);
+ $self->selected;
}
-sub status {
- my $pcnt = int(($pos || 0) * 100 / ($#lines || 1));
- my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);
-
+=head2 redraw_statusline
+
+Redraw status line
+
+ $iselect->redraw_statusline;
+
+=cut
+
+sub redraw_statusline {
+ my $self = shift;
+
+ my $pcnt = int(($pos || 0) * 100 / ( $nr_lines || 1 ) );
+ my $pos_txt = sprintf('%d/%s, %d%% ',$pos,$nr_lines,$pcnt);
+
+ my $scr = $self->screen || confess "need screen";
+
+ my $status_text = sprintf("pos: %-3d sel_pos: %-3d top_screen_line: %-3d", $pos, $sel_pos, $top_screen_line );
+
+ $status_text .= ' ' . $self->status_text if $self->status_text;
+
$scr->at($scr->rows - $status_lines + 1,0)->reverse()->puts(
sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text)
.$pos_txt)->normal();
+
$scr->at($scr->rows - $status_lines + 2,0)->puts(
- sprintf('%-'.$scr->cols.'s', $error_text)
- );
+ sprintf('%-'.$scr->cols.'s', $self->error_text)
+ ) if $self->error_text;
}
+=head2 selected
+
+Move selection (or refresh it)
+
+ $iselect->selected( +1 );
+ $iselect->selected( -1 );
+ $iselect->selected( 0 );
+
+=cut
+
sub selected {
+ my $self = shift;
+
my $d = shift || 0;
my $screen_line = $pos - $top_screen_line;
- redraw_line( $screen_line, $lines[$pos] );
+ $self->redraw_line( $screen_line, $self->lines->[$pos] );
- my $last_screen_line = $scr->rows - $status_lines;
+ my $last_screen_line = $self->screen->rows - $status_lines;
if ( $d < 0 && $screen_line == 0 ) {
if ( $pos > 0 ) {
$top_screen_line--;
$pos--;
} else {
- $error_text = "Already at Begin.";
+ $self->error_text( "Already at Begin." );
}
- redraw;
+ $self->redraw_screen;
} elsif ( $d > 0 && $screen_line == $last_screen_line ) {
- if ( $pos < $#lines ) {
+ if ( $pos < $nr_lines ) {
$top_screen_line++;
$pos++;
} else {
- $error_text = "Already at End.";
+ $self->error_text( "Already at End." );
}
- redraw;
+ $self->redraw_screen;
} else {
$pos += $d;
}
- my $line = $lines[$pos];
+ my $line = $self->lines->[$pos];
if ( defined $selectable_line->{ $pos } ) {
- $scr->at($pos - $top_screen_line,0)->reverse->bold()->puts( full_line( chunk($line) ) )->normal();
+ $self->screen->at($pos - $top_screen_line,0)->reverse->bold()->puts( $self->full_line( $line ) )->normal();
$sel_pos = $pos;
} else {
- $scr->at($pos - $top_screen_line,0)->reverse->puts( full_line( chunk($line) ) );
+ $self->screen->at($pos - $top_screen_line,0)->reverse->puts( $self->full_line( $line ) );
$sel_pos = -1;
}
- status;
+ $self->redraw_statusline;
}
-=head2 screen
+=head2 loop
- Term::ISelect->screen(
+ $iselect->loop(
sub {
my $line = shift;
warn "got line: $line\n";
- },
- qw/various lines to be used/,
+ }
);
=cut
-sub screen {
- my $class = shift;
+sub loop {
+ my $self = shift;
my $callback = shift;
confess "expect callback as first arg" unless ref($callback) eq 'CODE';
- @lines = @_;
+ my @lines = $self->lines;
# find which lines are selectable in input file
for my $l (0 .. $#lines) {
@@ -155,61 +236,77 @@
warn "selected first selectable line $sel_pos";
}
- $scr = new Term::Screen || die "can't init Term::Screen";
- $scr->clrscr()->noecho();
- redraw;
- selected;
+ $self->open_screen unless $self->screen;
- while(my $key = $scr->getch()) {
+ $self->screen->clrscr()->noecho();
+ $self->redraw_screen;
+ $self->selected;
- $error_text = "";
+ while(my $key = $self->screen->getch()) {
- my $lines_on_screen = $scr->rows - $status_lines;
+ my $lines_on_screen = $self->screen->rows - $status_lines;
if ($key eq 'ku') {
- selected( -1 );
+ $self->selected( -1 );
} elsif ($key eq 'kd') {
- selected( +1 );
+ $self->selected( +1 );
} elsif ($key eq 'pgup' ) {
# first line on screen?
if ( $pos == $top_screen_line ) {
$top_screen_line -= $lines_on_screen;
$top_screen_line = 0 if $top_screen_line < 0;
- redraw;
+ $self->redraw_screen;
}
- selected( -( $pos - $top_screen_line ) );
+ $self->selected( -( $pos - $top_screen_line ) );
} elsif ($key eq 'pgdn' ) {
# last line on screen?
if ( $pos - $top_screen_line == $lines_on_screen ) {
$top_screen_line += $lines_on_screen;
$top_screen_line = $#lines - $lines_on_screen if $top_screen_line >= $#lines - $lines_on_screen;
- redraw;
+ $self->redraw_screen;
}
- selected( $top_screen_line + $lines_on_screen - $pos );
+ $self->selected( $top_screen_line + $lines_on_screen - $pos );
}
- $status_text = sprintf("pos: %-3d sel_pos: %-3d top_screen_line: %-3d", $pos, $sel_pos, $top_screen_line );
if ( length($key) > 1 ) {
- $status_text .= " key: $key";
+ $self->status_text("key: $key");
} else {
- $status_text .= sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) );
+ $self->status_text( sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) ) );
}
# CTRL+L
- redraw if ord($key) eq 0x0c;
+ $self->redraw_screen if ord($key) eq 0x0c;
# Enter
if ( ord($key) eq 0x0d && $sel_pos > 0 ) {
- $error_text = "execute: " . $lines[ $sel_pos ];
+ $self->error_text( "execute: " . $lines[ $sel_pos ] );
}
- exit if (lc($key) eq 'q');
+ return if (lc($key) eq 'q');
- status;
+ $self->redraw_statusline;
}
- $scr->clrscr();
+ $self->clrscr();
}
+=head1 SEE ALSO
+
+L - Interactive Terminal Selection
+written by Ralf S. Engelschall which is original implementation in C
+
+=head1 AUTHOR
+
+Dobrica Pavlinusic, C<< >>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2006-2007 Dobrica Pavlinusic, All Rights Reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
1;