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/
screen
lines
error_text
status_text

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
  });

=head2 open_screen

  $iselect->open_screen;

=cut

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

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_lines = 3;

my $selectable_line;

=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;
        $t = substr($t,0,$cols) if length($t) > $cols;
        return $t . (" " x ($cols - length($t)));
}


=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 } ) {
                $self->screen->at($l,0)->bold()->puts( $self->full_line( $line ) )->normal();
        } else {
                $self->screen->at($l,0)->puts( $self->full_line( $line ) )
        }
}

=head2 redraw_screen

  $iselect->redraw_screen

=cut

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

=head2 redraw_statusline

Redraw status line

  $iselect->redraw_statusline;

=cut

sub redraw_statusline {
        my $self = shift;

        my @lines = $self->lines;

        my $pcnt = int(($pos || 0) * 100 / ( $#lines || 1));
        my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);

        my $scr = $self->screen || confess "need screen";

        $scr->at($scr->rows - $status_lines + 1,0)->reverse()->puts(
                sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$self->status_text)
        .$pos_txt)->normal() if $self->status_text;

        $scr->at($scr->rows - $status_lines + 2,0)->puts(
                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;

        $self->redraw_line( $screen_line, ($self->lines)[$pos] );

        my $last_screen_line = $self->screen->rows - $status_lines;

        if ( $d < 0 && $screen_line == 0 ) {
                if ( $pos > 0 ) {
                        $top_screen_line--;
                        $pos--;
                } else {
                        $self->error_text( "Already at Begin." );
                }
                $self->redraw_screen;
        } elsif ( $d > 0 && $screen_line == $last_screen_line ) {
                if ( $pos < scalar($self->lines) ) {
                        $top_screen_line++;
                        $pos++;
                } else {
                        $self->error_text( "Already at End." );
                }
                $self->redraw_screen;
        } else {
                $pos += $d;
        }

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


=head2 loop

  $iselect->loop(
        sub {
                my $line = shift;
                warn "got line: $line\n";
        }
  );

=cut

sub loop {
        my $self = shift;

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

        my @lines = $self->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";
        }

        $self->open_screen unless $self->screen;

        $self->screen->clrscr()->noecho();
        $self->redraw_screen;
        $self->selected;

        while(my $key = $self->screen->getch()) {

                my $lines_on_screen = $self->screen->rows - $status_lines;

                if ($key eq 'ku') {
                        $self->selected( -1 );
                } elsif ($key eq 'kd') {
                        $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;
                                $self->redraw_screen;
                        }
                        $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;
                                $self->redraw_screen;
                        }
                        $self->selected( $top_screen_line + $lines_on_screen - $pos );
                }

                my $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) );
                }
                $self->status_text( $status_text );

                # CTRL+L
                $self->redraw_screen if ord($key) eq 0x0c;

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

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

                $self->redraw_statusline;

        }

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