--- ISelect.pm 2007/10/25 15:50:56 12 +++ ISelect.pm 2007/10/25 21:27:58 23 @@ -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.02'; =head1 NAME @@ -15,136 +26,211 @@ =head1 METHODS -=cut +=head2 new + + my $iselect = Term::ISelect->new({ + lines => [ + 'first line', + '{s}second selectable line', + '', + 'last line', + ], + debug => 1 + }); -my $scr; +=head2 open_screen + + $iselect->open_screen; + +=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 =~ s/{s}//; + $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 to some line of document + + $iselect->selected( 42 ); + +=cut + sub selected { - my $d = shift || 0; + my $self = shift; - my $screen_line = $pos - $top_screen_line; + my $new_pos = shift; - redraw_line( $screen_line, $lines[$pos] ); + if ( defined $new_pos ) { - my $last_screen_line = $scr->rows - $status_lines; + my $screen_line = $pos - $top_screen_line; + $self->redraw_line( $screen_line, $self->lines->[$pos] ); - if ( $d < 0 && $screen_line == 0 ) { - if ( $pos > 0 ) { - $top_screen_line--; - $pos--; - } else { - $error_text = "Already at Begin."; - } - redraw; - } elsif ( $d > 0 && $screen_line == $last_screen_line ) { - if ( $pos < $#lines ) { - $top_screen_line++; - $pos++; + my $last_screen_line = $self->screen->rows - $status_lines; + + if ( $new_pos < $pos && $screen_line == 0 ) { + if ( $pos > 0 ) { + $top_screen_line--; + $pos--; + $self->screen->at(0,0)->il; + $self->error_text( ' ' ); + } else { + $self->error_text( "Already at Begin." ); + } + } elsif ( $new_pos > $pos && $screen_line == $last_screen_line ) { + if ( $pos < $nr_lines ) { + $top_screen_line++; + $pos++; + $self->screen->at(0,0)->dl; + } else { + $self->error_text( "Already at End." ); + } } else { - $error_text = "Already at End."; + $pos = $new_pos; } - redraw; - } 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) { - if ($lines[$l] =~ s/^{s}//) { + if ($lines[$l] =~ m/^{s}/) { $selectable_line->{$l}++; } } @@ -155,61 +241,113 @@ 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; + + $self->screen->clrscr()->noecho(); + $self->redraw_screen; + $self->selected; - while(my $key = $scr->getch()) { + my $lines_on_screen = $self->screen->rows - $status_lines; + my $max_top_screen_line = + $nr_lines > $lines_on_screen ? $nr_lines - $lines_on_screen : 0; - $error_text = ""; + while(my $key = $self->screen->getch()) { - my $lines_on_screen = $scr->rows - $status_lines; + $self->error_text(''); if ($key eq 'ku') { - selected( -1 ); + $self->selected( $pos - 1 ); } elsif ($key eq 'kd') { - selected( +1 ); + $self->selected( $pos + 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; + } + if ( $pos == $top_screen_line ) { + $self->error_text( "Already at top." ); + } else { + $self->selected( $top_screen_line ); } - 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; + $top_screen_line = $max_top_screen_line if $top_screen_line > $max_top_screen_line; + $self->redraw_screen; + } + if ( $pos == $nr_lines ) { + $self->error_text( "Already at bottom." ); + } else { + $self->selected( $top_screen_line + $lines_on_screen ); + } + } elsif ($key eq 'g' ) { + if ( $top_screen_line == 0 ) { + if ( $pos == 0 ) { + $self->error_text( "Already at top." ); + } else { + $self->selected( 0 ); + } + } else { + $top_screen_line = 0; + $pos = 0; + $self->redraw_screen; + } + } elsif ($key eq 'G' ) { + if ( $top_screen_line == $max_top_screen_line ) { + if ( $pos == $nr_lines ) { + $self->error_text( "Already at bottom." ); + } else { + $self->selected( $nr_lines ); + } + } else { + $top_screen_line = $max_top_screen_line; + $pos = $nr_lines; + $self->redraw_screen; } - 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;