/[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

Annotation of /ISelect.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 13 - (hide annotations)
Thu Oct 25 16:08:43 2007 UTC (12 years ago) by dpavlin
File size: 5191 byte(s)
move towards Class::Accessor usage
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;

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26