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

Diff of /ISelect.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 12 by dpavlin, Thu Oct 25 15:50:56 2007 UTC revision 23 by dpavlin, Thu Oct 25 21:27:58 2007 UTC
# Line 7  use Term::Screen; Line 7  use Term::Screen;
7  use Carp qw/cluck confess/;  use Carp qw/cluck confess/;
8  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
9    
10  our $VERSION = '0.00';  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.02';
22    
23  =head1 NAME  =head1 NAME
24    
# Line 15  Term::ISelect - perl only implementation Line 26  Term::ISelect - perl only implementation
26    
27  =head1 METHODS  =head1 METHODS
28    
29  =cut  =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  my $scr;  =head2 open_screen
42    
43      $iselect->open_screen;
44    
45    =cut
46    
47  # leave sane terminal if script dies  # leave sane terminal if script dies
48  $SIG{__DIE__} = sub {  $SIG{__DIE__} = sub {
49      eval { system('stty sane'); };      eval { system('stty sane'); };
50  };  };
51    
52  my @lines;  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  my $top_screen_line = 0;        # offset in original text
58  my $pos = 0;  my $pos = 0;
59    
60  # default: select first line  # default: select first line
61  my $sel_pos = 0;  my $sel_pos = 0;
 my $status_text = '';  
 my $error_text = '';  
62    
63  my $status_lines = 3;  my $status_lines = 3;
64    
65  my $selectable_line;  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 {  sub full_line {
78            my $self = shift;
79    
80            my $cols = $self->screen->cols;
81    
82          my $t = shift;          my $t = shift;
83    
84            $t =~ s/{s}//;
85    
86          $t = '' unless defined $t;          $t = '' unless defined $t;
87          return $t . (" " x ($scr->cols - length($t)));          $t = substr($t,0,$cols) if length($t) > $cols;
88            return $t . (" " x ($cols - length($t)));
89  }  }
90    
91  sub chunk {  
92          my $t = shift;  =head2 redraw_line
93          cluck "expected line" unless defined $t;  
94          return substr($t,0,$scr->cols);    $iselect->redraw_line( $line_on_screen, $content_of_line );
95  }  
96    =cut
97    
98  sub redraw_line {  sub redraw_line {
99            my $self = shift;
100    
101          my ($l,$line) = @_;          my ($l,$line) = @_;
102    
103          if ( defined $selectable_line->{ $l + $top_screen_line } ) {          if ( defined $selectable_line->{ $l + $top_screen_line } ) {
104                  $scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();                  $self->screen->at($l,0)->bold()->puts( $self->full_line( $line ) )->normal();
105          } else {          } else {
106                  $scr->at($l,0)->puts( full_line( chunk($line) ) );                  $self->screen->at($l,0)->puts( $self->full_line( $line ) )
107          }          }
108  }  }
109    
110  sub redraw {  =head2 redraw_screen
111          for my $l (0 .. $scr->rows - $status_lines) {  
112      $iselect->redraw_screen
113    
114    =cut
115    
116    sub redraw_screen {
117            my $self = shift;
118            my @lines = @{ $self->lines };
119            $nr_lines = $#lines;
120            for my $l (0 .. $self->screen->rows - $status_lines) {
121                  my $line = $lines[ $l + $top_screen_line ];                  my $line = $lines[ $l + $top_screen_line ];
122                  redraw_line( $l, $line );                  $self->redraw_line( $l, $line );
123                  last if ($l == $#lines);                  last if ($l == $#lines);
124          }          }
125          selected(0);          $self->selected;
126  }  }
127    
128  sub status {  =head2 redraw_statusline
129          my $pcnt = int(($pos || 0) * 100 / ($#lines || 1));  
130          my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);  Redraw status line
131            
132      $iselect->redraw_statusline;
133    
134    =cut
135    
136    sub redraw_statusline {
137            my $self = shift;
138    
139            my $pcnt = int(($pos || 0) * 100 / ( $nr_lines || 1 ) );
140            my $pos_txt = sprintf('%d/%s, %d%% ',$pos,$nr_lines,$pcnt);
141    
142            my $scr = $self->screen || confess "need screen";
143    
144            my $status_text = sprintf("pos: %-3d sel_pos: %-3d top_screen_line: %-3d", $pos, $sel_pos, $top_screen_line );
145    
146            $status_text .= ' ' . $self->status_text if $self->status_text;
147    
148          $scr->at($scr->rows - $status_lines + 1,0)->reverse()->puts(          $scr->at($scr->rows - $status_lines + 1,0)->reverse()->puts(
149                  sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text)                  sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text)
150          .$pos_txt)->normal();          .$pos_txt)->normal();
151    
152          $scr->at($scr->rows - $status_lines + 2,0)->puts(          $scr->at($scr->rows - $status_lines + 2,0)->puts(
153                  sprintf('%-'.$scr->cols.'s', $error_text)                  sprintf('%-'.$scr->cols.'s', $self->error_text )
154          );          ) if $self->error_text;
155  }  }
156    
157    =head2 selected
158    
159    Move selection to some line of document
160    
161      $iselect->selected( 42 );
162    
163    =cut
164    
165  sub selected {  sub selected {
166          my $d = shift || 0;          my $self = shift;
167    
168          my $screen_line = $pos - $top_screen_line;          my $new_pos = shift;
169    
170          redraw_line( $screen_line, $lines[$pos] );          if ( defined $new_pos ) {
171    
172          my $last_screen_line = $scr->rows - $status_lines;                  my $screen_line = $pos - $top_screen_line;
173                    $self->redraw_line( $screen_line, $self->lines->[$pos] );
174    
175          if ( $d < 0 && $screen_line == 0 ) {                  my $last_screen_line = $self->screen->rows - $status_lines;
176                  if ( $pos > 0 ) {  
177                          $top_screen_line--;                  if ( $new_pos < $pos && $screen_line == 0 ) {
178                          $pos--;                          if ( $pos > 0 ) {
179                  } else {                                  $top_screen_line--;
180                          $error_text = "Already at Begin.";                                  $pos--;
181                  }                                  $self->screen->at(0,0)->il;
182                  redraw;                                  $self->error_text( ' ' );
183          } elsif ( $d > 0 && $screen_line == $last_screen_line ) {                          } else {
184                  if ( $pos < $#lines ) {                                  $self->error_text( "Already at Begin." );
185                          $top_screen_line++;                          }
186                          $pos++;                  } elsif ( $new_pos > $pos && $screen_line == $last_screen_line ) {
187                            if ( $pos < $nr_lines ) {
188                                    $top_screen_line++;
189                                    $pos++;
190                                    $self->screen->at(0,0)->dl;
191                            } else {
192                                    $self->error_text( "Already at End." );
193                            }
194                  } else {                  } else {
195                          $error_text = "Already at End.";                          $pos = $new_pos;
196                  }                  }
197                  redraw;          
         } else {  
                 $pos += $d;  
198          }          }
199    
200          my $line = $lines[$pos];          my $line = $self->lines->[$pos];
201          if ( defined $selectable_line->{ $pos } ) {          if ( defined $selectable_line->{ $pos } ) {
202                  $scr->at($pos - $top_screen_line,0)->reverse->bold()->puts( full_line( chunk($line) ) )->normal();                  $self->screen->at($pos - $top_screen_line,0)->reverse->bold()->puts( $self->full_line( $line ) )->normal();
203                  $sel_pos = $pos;                  $sel_pos = $pos;
204          } else {          } else {
205                  $scr->at($pos - $top_screen_line,0)->reverse->puts( full_line( chunk($line) ) );                  $self->screen->at($pos - $top_screen_line,0)->reverse->puts( $self->full_line( $line ) );
206                  $sel_pos = -1;                  $sel_pos = -1;
207          }          }
208          status;          $self->redraw_statusline;
209  }  }
210    
211    
212  =head2 screen  =head2 loop
213    
214    Term::ISelect->screen(    $iselect->loop(
215          sub {          sub {
216                  my $line = shift;                  my $line = shift;
217                  warn "got line: $line\n";                  warn "got line: $line\n";
218          },          }
         qw/various lines to be used/,  
219    );    );
220    
221  =cut  =cut
222    
223  sub screen {  sub loop {
224          my $class = shift;          my $self = shift;
225    
226          my $callback = shift;          my $callback = shift;
227          confess "expect callback as first arg" unless ref($callback) eq 'CODE';          confess "expect callback as first arg" unless ref($callback) eq 'CODE';
228    
229          @lines = @_;          my @lines = @{ $self->lines };
230    
231          # find which lines are selectable in input file          # find which lines are selectable in input file
232          for my $l (0 .. $#lines) {          for my $l (0 .. $#lines) {
233                  if ($lines[$l] =~ s/^{s}//) {                  if ($lines[$l] =~ m/^{s}/) {
234                          $selectable_line->{$l}++;                          $selectable_line->{$l}++;
235                  }                  }
236          }          }
# Line 155  sub screen { Line 241  sub screen {
241                  warn "selected first selectable line $sel_pos";                  warn "selected first selectable line $sel_pos";
242          }          }
243    
244          $scr = new Term::Screen || die "can't init Term::Screen";          $self->open_screen unless $self->screen;
245          $scr->clrscr()->noecho();  
246          redraw;          $self->screen->clrscr()->noecho();
247          selected;          $self->redraw_screen;
248            $self->selected;
249    
250          while(my $key = $scr->getch()) {          my $lines_on_screen = $self->screen->rows - $status_lines;
251            my $max_top_screen_line =
252                            $nr_lines > $lines_on_screen ?  $nr_lines - $lines_on_screen : 0;      
253    
254                  $error_text = "";          while(my $key = $self->screen->getch()) {
255    
256                  my $lines_on_screen = $scr->rows - $status_lines;                  $self->error_text('');
257    
258                  if ($key eq 'ku') {                  if ($key eq 'ku') {
259                          selected( -1 );                          $self->selected( $pos - 1 );
260                  } elsif ($key eq 'kd') {                  } elsif ($key eq 'kd') {
261                          selected( +1 );                          $self->selected( $pos + 1 );
262                  } elsif ($key eq 'pgup' ) {                  } elsif ($key eq 'pgup' ) {
263                          # first line on screen?                          # first line on screen?
264                          if ( $pos == $top_screen_line ) {                          if ( $pos == $top_screen_line ) {
265                                  $top_screen_line -= $lines_on_screen;                                  $top_screen_line -= $lines_on_screen;
266                                  $top_screen_line = 0 if $top_screen_line < 0;                                  $top_screen_line = 0 if $top_screen_line < 0;
267                                  redraw;                                  $self->redraw_screen;
268                            }
269                            if ( $pos == $top_screen_line ) {
270                                    $self->error_text( "Already at top." );
271                            } else {
272                                    $self->selected( $top_screen_line );
273                          }                          }
                         selected( -( $pos - $top_screen_line ) );  
274                  } elsif ($key eq 'pgdn' ) {                  } elsif ($key eq 'pgdn' ) {
275                          # last line on screen?                          # last line on screen?
276                          if ( $pos - $top_screen_line == $lines_on_screen ) {                          if ( $pos - $top_screen_line == $lines_on_screen ) {
277                                  $top_screen_line += $lines_on_screen;                                  $top_screen_line += $lines_on_screen;
278                                  $top_screen_line = $#lines - $lines_on_screen if $top_screen_line >= $#lines - $lines_on_screen;                                  $top_screen_line = $max_top_screen_line if $top_screen_line > $max_top_screen_line;
279                                  redraw;                                  $self->redraw_screen;
280                            }
281                            if ( $pos == $nr_lines ) {
282                                    $self->error_text( "Already at bottom." );
283                            } else {
284                                    $self->selected( $top_screen_line + $lines_on_screen );
285                            }
286                    } elsif ($key eq 'g' ) {
287                            if ( $top_screen_line == 0 ) {
288                                    if ( $pos == 0 ) {
289                                            $self->error_text( "Already at top." );
290                                    } else {
291                                            $self->selected( 0 );
292                                    }
293                            } else {
294                                    $top_screen_line = 0;
295                                    $pos = 0;
296                                    $self->redraw_screen;
297                            }
298                    } elsif ($key eq 'G' ) {
299                            if ( $top_screen_line == $max_top_screen_line ) {
300                                    if ( $pos == $nr_lines ) {
301                                            $self->error_text( "Already at bottom." );
302                                    } else {
303                                            $self->selected( $nr_lines );
304                                    }
305                            } else {
306                                    $top_screen_line = $max_top_screen_line;
307                                    $pos = $nr_lines;
308                                    $self->redraw_screen;
309                          }                          }
                         selected( $top_screen_line + $lines_on_screen - $pos );  
310                  }                  }
311    
                 $status_text = sprintf("pos: %-3d sel_pos: %-3d top_screen_line: %-3d", $pos, $sel_pos, $top_screen_line );  
312                  if ( length($key) > 1 ) {                  if ( length($key) > 1 ) {
313                          $status_text .= " key: $key";                          $self->status_text("key: $key");
314                  } else {                  } else {
315                          $status_text .= sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) );                          $self->status_text( sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) ) );
316                  }                  }
317    
318                  # CTRL+L                  # CTRL+L
319                  redraw if ord($key) eq 0x0c;                  $self->redraw_screen if ord($key) eq 0x0c;
320    
321                  # Enter                  # Enter
322                  if ( ord($key) eq 0x0d && $sel_pos > 0 ) {                  if ( ord($key) eq 0x0d && $sel_pos > 0 ) {
323                          $error_text = "execute: " . $lines[ $sel_pos ];                          $self->error_text( "execute: " . $lines[ $sel_pos ] );
324                  }                  }
325    
326                  exit if (lc($key) eq 'q');                  return if (lc($key) eq 'q');
327    
328                  status;                  $self->redraw_statusline;
329    
330          }          }
331    
332          $scr->clrscr();          $self->clrscr();
333  }  }
334    
335    =head1 SEE ALSO
336    
337    L<http://www.ossp.org/pkg/tool/iselect/> - Interactive Terminal Selection
338    written by Ralf S. Engelschall which is original implementation in C
339    
340    =head1 AUTHOR
341    
342    Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
343    
344    =head1 COPYRIGHT & LICENSE
345    
346    Copyright 2006-2007 Dobrica Pavlinusic, All Rights Reserved.
347    
348    This program is free software; you can redistribute it and/or modify it
349    under the same terms as Perl itself.
350    
351    =cut
352    
353  1;  1;

Legend:
Removed from v.12  
changed lines
  Added in v.23

  ViewVC Help
Powered by ViewVC 1.1.26