/[iselect]/bin/iselect.pl
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 /bin/iselect.pl

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

iselect.pl revision 1 by dpavlin, Thu Oct 25 11:22:18 2007 UTC bin/iselect.pl revision 14 by dpavlin, Thu Oct 25 17:24:33 2007 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl -w  #!/usr/bin/perl -w
2    
3  use strict;  use strict;
4  use Term::Screen;  
5    use blib;
6    
7    use Term::ISelect;
8  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
9    
10  my $data = <<'EOF';  my $data = <<'EOF';
11   First line   First line
12    
13  +first selectable  {s}first selectable
14  + second selectable  {s}second selectable
15    
16   a space....   a space....
17    
18                                      ...infinity and beyond                                      ...infinity and beyond
19    
20    
21  +foo  {s}foo
22  +bar  {s}bar
23    
24   bum   bum
 EOF  
25    
26  open(my $ps, "ps ax |") || die "can't do ps ax: $!";  EOF
 while(<$ps>) {  
         $data .= '+'.$_;  
         $data .= ' '.$_;  
 }  
 close($ps);  
   
   
 my @lines = split(/\n/, $data);  
   
 my $scr = new Term::Screen || die "can't init Term::Screen";  
 $scr->clrscr()->noecho();  
   
 my $o = 0;      # offset in original text  
 my $pos = 0;  
27    
28  # find which lines are selectable in input file  $data .= ( rand(10) < 5 ? '{s}' : '' ) . "foobar $_\n" foreach ( 1 .. 300 );
 my $selectable_line;  
29    
30  for my $l (0 .. $#lines) {  $data .= "\n--EOF--";
         next if (length($lines[$l]) < 2);  
         my $foo = ' ';  
         if ($lines[$l] !~ m/^\s/o) {  
                 $selectable_line->{$l}++;  
                 $foo = '*';  
         }  
         warn "$l: $foo $lines[$l]\n";  
 }  
   
 sub full_line {  
         my $t = shift;  
         my $l = length($t);  
         return $t . (" " x ($scr->cols - length($t)));  
 }  
   
 sub chunk {  
         my $t = shift;  
         my $o = '';  
         $o = substr($t,1,$scr->cols) if length($t) > 1;  
         return $o . ( ' ' x ( $scr->cols - length($o) - 1 ) );  
 }  
   
 sub redraw {  
         for my $l (0 .. $scr->rows) {  
                 my $line = $lines[ $l + $o ] || '';  
                 next if (length($line) < 2);  
                 if (substr($line,0,1) !~ m/^\s/o) {  
                         $scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();  
                 } else {  
                         $scr->at($l,0)->puts( full_line( chunk($line) ) );  
                 }  
                 last if ($l == $#lines);  
         }  
 }  
   
 # default: select first line  
 my $sel_pos = 0;  
 my $status_text = '';  
 my $error_text = '';  
 $pos = 0;  
   
 sub status {  
         my $pcnt = int(($pos || 0) * 100 / ($#lines || 1));  
         my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);  
31                    
32          $scr->at($scr->rows - 2,0)->reverse()->puts(  my @lines = split(/\n/, $data);
33                  sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text)  warn "lines = ", dump( @lines );
         .$pos_txt)->normal();  
         $scr->at($scr->rows - 1,0)->puts(  
                 sprintf('%-'.$scr->cols.'s', $error_text)  
         );  
 }  
   
 sub selected {  
         my $d = shift || return;  
   
         if ( $selectable_line->{ $pos } ) {  
                 $scr->at($pos-$o,0)->bold()->puts( chunk($lines[$pos]) )->normal();  
         } else {  
                 $scr->at($pos-$o,0)->puts( chunk($lines[$pos]) )->normal();  
         }  
         $pos += $d;  
   
         my $max_row = $scr->rows - 3;  
   
         if ($pos < 1) {  
                 $error_text = "Already at Begin.";  
                 $pos = 0;  
                 redraw;  
         } elsif ($pos > $max_row) {  
                 $o = $pos - $max_row;   # put selected line on last  
                 $error_text = "Already at End.";  
                 redraw;  
         }  
   
         $scr->at($pos-$o,0)->reverse()->puts(chunk($lines[$pos]))->normal();  
         status;  
 }  
   
 $status_text = "let's see does it work?";  
 redraw;  
 selected;  
   
 while(my $key = $scr->getch()) {  
   
         $status_text = "key: $key pos: $pos sel_pos: $sel_pos";  
         $error_text = "";  
   
         if ($key eq 'ku') {  
                 selected( -1 );  
         } elsif ($key eq 'kd') {  
                 selected( +1 );  
         }  
   
         status;  
34    
35          exit if (lc($key) eq 'q');  my $iselect = Term::ISelect->new({
36  }          lines => [ @lines ],
37    });
38    
39    $iselect->loop(
40            sub {
41                    warn "## ",dump(@_);
42            },
43    );
44    
 $scr->clrscr();  
Legend:
Removed from v.1  
changed lines
  Added in v.14
  ViewVC Help
Powered by ViewVC 1.1.26