/[iselect]/ISelect.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /ISelect.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26