/[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 13 - (show annotations)
Thu Oct 25 16:08:43 2007 UTC (11 years, 7 months ago) by dpavlin
File size: 5191 byte(s)
move towards Class::Accessor usage
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 lines
13
14 debug
15 / );
16
17
18 our $VERSION = '0.01';
19
20 =head1 NAME
21
22 Term::ISelect - perl only implementation of Interactive Terminal Selection
23
24 =head1 METHODS
25
26 =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 =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 =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 1;

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26