viewvc.cgi/iselect/ISelect.pm

package Term::ISelect;

use warnings;
use strict;

use Term::Screen;
use Carp qw/cluck confess/;
use Data::Dump qw/dump/;

use base qw/Class::Accessor/;
__PACKAGE__->mk_accessors( qw/
lines

debug
/ );


our $VERSION = '0.01';

=head1 NAME

Term::ISelect - perl only implementation of Interactive Terminal Selection

=head1 METHODS

=head2 new

  my $iselect = Term::ISelect->new({
        lines => [
                'first line',
                '{s}second selectable line',
                '',
                'last line',
        ],                                                           
        debug => 1
  });

=cut

my $scr;

# leave sane terminal if script dies
$SIG{__DIE__} = sub {
    eval { system('stty sane'); };
};

my @lines;

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;

sub full_line {
        my $t = shift;
        $t = '' unless defined $t;
        return $t . (" " x ($scr->cols - length($t)));
}

sub chunk {
        my $t = shift;
        cluck "expected line" unless defined $t;
        return substr($t,0,$scr->cols);
}

sub redraw_line {
        my ($l,$line) = @_;

        if ( defined $selectable_line->{ $l + $top_screen_line } ) {
                $scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();
        } else {
                $scr->at($l,0)->puts( full_line( chunk($line) ) );
        }
}

sub redraw {
        for my $l (0 .. $scr->rows - $status_lines) {
                my $line = $lines[ $l + $top_screen_line ];
                redraw_line( $l, $line );
                last if ($l == $#lines);
        }
        selected(0);
}

sub status {
        my $pcnt = int(($pos || 0) * 100 / ($#lines || 1));
        my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);
        
        $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)
        );
}

sub selected {
        my $d = shift || 0;

        my $screen_line = $pos - $top_screen_line;

        redraw_line( $screen_line, $lines[$pos] );

        my $last_screen_line = $scr->rows - $status_lines;

        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++;
                } else {
                        $error_text = "Already at End.";
                }
                redraw;
        } else {
                $pos += $d;
        }

        my $line = $lines[$pos];
        if ( defined $selectable_line->{ $pos } ) {
                $scr->at($pos - $top_screen_line,0)->reverse->bold()->puts( full_line( chunk($line) ) )->normal();
                $sel_pos = $pos;
        } else {
                $scr->at($pos - $top_screen_line,0)->reverse->puts( full_line( chunk($line) ) );
                $sel_pos = -1;
        }
        status;
}


=head2 screen

  Term::ISelect->screen(
        sub {
                my $line = shift;
                warn "got line: $line\n";
        },
        qw/various lines to be used/,
  );

=cut

sub screen {
        my $class = shift;

        my $callback = shift;
        confess "expect callback as first arg" unless ref($callback) eq 'CODE';

        @lines = @_;

        # find which lines are selectable in input file
        for my $l (0 .. $#lines) {
                if ($lines[$l] =~ s/^{s}//) {
                        $selectable_line->{$l}++;
                }
        }

        # select first selectable line
        if ( $selectable_line ) {
                $pos = $sel_pos = (sort { $a <=> $b } keys %$selectable_line)[0];
                warn "selected first selectable line $sel_pos";
        }

        $scr = new Term::Screen || die "can't init Term::Screen";
        $scr->clrscr()->noecho();
        redraw;
        selected;

        while(my $key = $scr->getch()) {

                $error_text = "";

                my $lines_on_screen = $scr->rows - $status_lines;

                if ($key eq 'ku') {
                        selected( -1 );
                } elsif ($key eq 'kd') {
                        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;
                        }
                        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;
                        }
                        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";
                } else {
                        $status_text .= sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) );
                }

                # CTRL+L
                redraw if ord($key) eq 0x0c;

                # Enter
                if ( ord($key) eq 0x0d && $sel_pos > 0 ) {
                        $error_text = "execute: " . $lines[ $sel_pos ];
                }

                exit if (lc($key) eq 'q');

                status;

        }

        $scr->clrscr();
}

=head1 SEE ALSO

L<http://www.ossp.org/pkg/tool/iselect/> - Interactive Terminal Selection
written by Ralf S. Engelschall which is original implementation in C

=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=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;
1	dpavlin	12	package Term::ISelect;
2
3			use warnings;
4			use strict;
5
6			use Term::Screen;
7			use Carp qw/cluck confess/;
8			use Data::Dump qw/dump/;
9
10	dpavlin	13	use base qw/Class::Accessor/;
11			__PACKAGE__->mk_accessors( qw/
12			lines
13	dpavlin	12
14	dpavlin	13	debug
15			/ );
16
17
18			our $VERSION = '0.01';
19
20	dpavlin	12	=head1 NAME
21
22			Term::ISelect - perl only implementation of Interactive Terminal Selection
23
24			=head1 METHODS
25
26	dpavlin	13	=head2 new
27
28			my $iselect = Term::ISelect->new({
29			lines => [
30			'first line',
31			'{s}second selectable line',
32			'',
33			'last line',
34			],
35			debug => 1
36			});
37
38	dpavlin	12	=cut
39
40			my $scr;
41
42			# leave sane terminal if script dies
43			$SIG{__DIE__} = sub {
44			eval { system('stty sane'); };
45			};
46
47			my @lines;
48
49			my $top_screen_line = 0; # offset in original text
50			my $pos = 0;
51
52			# default: select first line
53			my $sel_pos = 0;
54			my $status_text = '';
55			my $error_text = '';
56
57			my $status_lines = 3;
58
59			my $selectable_line;
60
61			sub full_line {
62			my $t = shift;
63			$t = '' unless defined $t;
64			return $t . (" " x ($scr->cols - length($t)));
65			}
66
67			sub chunk {
68			my $t = shift;
69			cluck "expected line" unless defined $t;
70			return substr($t,0,$scr->cols);
71			}
72
73			sub redraw_line {
74			my ($l,$line) = @_;
75
76			if ( defined $selectable_line->{ $l + $top_screen_line } ) {
77			$scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();
78			} else {
79			$scr->at($l,0)->puts( full_line( chunk($line) ) );
80			}
81			}
82
83			sub redraw {
84			for my $l (0 .. $scr->rows - $status_lines) {
85			my $line = $lines[ $l + $top_screen_line ];
86			redraw_line( $l, $line );
87			last if ($l == $#lines);
88			}
89			selected(0);
90			}
91
92			sub status {
93			my $pcnt = int(($pos \|\| 0) * 100 / ($#lines \|\| 1));
94			my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);
95
96			$scr->at($scr->rows - $status_lines + 1,0)->reverse()->puts(
97			sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text)
98			.$pos_txt)->normal();
99			$scr->at($scr->rows - $status_lines + 2,0)->puts(
100			sprintf('%-'.$scr->cols.'s', $error_text)
101			);
102			}
103
104			sub selected {
105			my $d = shift \|\| 0;
106
107			my $screen_line = $pos - $top_screen_line;
108
109			redraw_line( $screen_line, $lines[$pos] );
110
111			my $last_screen_line = $scr->rows - $status_lines;
112
113			if ( $d < 0 && $screen_line == 0 ) {
114			if ( $pos > 0 ) {
115			$top_screen_line--;
116			$pos--;
117			} else {
118			$error_text = "Already at Begin.";
119			}
120			redraw;
121			} elsif ( $d > 0 && $screen_line == $last_screen_line ) {
122			if ( $pos < $#lines ) {
123			$top_screen_line++;
124			$pos++;
125			} else {
126			$error_text = "Already at End.";
127			}
128			redraw;
129			} else {
130			$pos += $d;
131			}
132
133			my $line = $lines[$pos];
134			if ( defined $selectable_line->{ $pos } ) {
135			$scr->at($pos - $top_screen_line,0)->reverse->bold()->puts( full_line( chunk($line) ) )->normal();
136			$sel_pos = $pos;
137			} else {
138			$scr->at($pos - $top_screen_line,0)->reverse->puts( full_line( chunk($line) ) );
139			$sel_pos = -1;
140			}
141			status;
142			}
143
144
145			=head2 screen
146
147			Term::ISelect->screen(
148			sub {
149			my $line = shift;
150			warn "got line: $line\n";
151			},
152			qw/various lines to be used/,
153			);
154
155			=cut
156
157			sub screen {
158			my $class = shift;
159
160			my $callback = shift;
161			confess "expect callback as first arg" unless ref($callback) eq 'CODE';
162
163			@lines = @_;
164
165			# find which lines are selectable in input file
166			for my $l (0 .. $#lines) {
167			if ($lines[$l] =~ s/^{s}//) {
168			$selectable_line->{$l}++;
169			}
170			}
171
172			# select first selectable line
173			if ( $selectable_line ) {
174			$pos = $sel_pos = (sort { $a <=> $b } keys %$selectable_line)[0];
175			warn "selected first selectable line $sel_pos";
176			}
177
178			$scr = new Term::Screen \|\| die "can't init Term::Screen";
179			$scr->clrscr()->noecho();
180			redraw;
181			selected;
182
183			while(my $key = $scr->getch()) {
184
185			$error_text = "";
186
187			my $lines_on_screen = $scr->rows - $status_lines;
188
189			if ($key eq 'ku') {
190			selected( -1 );
191			} elsif ($key eq 'kd') {
192			selected( +1 );
193			} elsif ($key eq 'pgup' ) {
194			# first line on screen?
195			if ( $pos == $top_screen_line ) {
196			$top_screen_line -= $lines_on_screen;
197			$top_screen_line = 0 if $top_screen_line < 0;
198			redraw;
199			}
200			selected( -( $pos - $top_screen_line ) );
201			} elsif ($key eq 'pgdn' ) {
202			# last line on screen?
203			if ( $pos - $top_screen_line == $lines_on_screen ) {
204			$top_screen_line += $lines_on_screen;
205			$top_screen_line = $#lines - $lines_on_screen if $top_screen_line >= $#lines - $lines_on_screen;
206			redraw;
207			}
208			selected( $top_screen_line + $lines_on_screen - $pos );
209			}
210
211			$status_text = sprintf("pos: %-3d sel_pos: %-3d top_screen_line: %-3d", $pos, $sel_pos, $top_screen_line );
212			if ( length($key) > 1 ) {
213			$status_text .= " key: $key";
214			} else {
215			$status_text .= sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) );
216			}
217
218			# CTRL+L
219			redraw if ord($key) eq 0x0c;
220
221			# Enter
222			if ( ord($key) eq 0x0d && $sel_pos > 0 ) {
223			$error_text = "execute: " . $lines[ $sel_pos ];
224			}
225
226			exit if (lc($key) eq 'q');
227
228			status;
229
230			}
231
232			$scr->clrscr();
233			}
234
235	dpavlin	13	=head1 SEE ALSO
236
237			L<http://www.ossp.org/pkg/tool/iselect/> - Interactive Terminal Selection
238			written by Ralf S. Engelschall which is original implementation in C
239
240			=head1 AUTHOR
241
242			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
243
244			=head1 COPYRIGHT & LICENSE
245
246			Copyright 2006-2007 Dobrica Pavlinusic, All Rights Reserved.
247
248			This program is free software; you can redistribute it and/or modify it
249			under the same terms as Perl itself.
250
251			=cut
252
253	dpavlin	12	1;