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

revision 3 by dpavlin, Thu Oct 25 11:47:40 2007 UTC revision 4 by dpavlin, Thu Oct 25 12:45:18 2007 UTC
# Line 2  Line 2 
2    
3  use strict;  use strict;
4  use Term::Screen;  use Term::Screen;
5    use Carp qw/confess/;
6  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
7    
8  my $data = <<'EOF';  my $data = <<'EOF';
9   First line   First line
10    
11  +first selectable  {s}first selectable
12  + second selectable  {s}second selectable
13    
14   a space....   a space....
15    
16                                      ...infinity and beyond                                      ...infinity and beyond
17    
18    
19  +foo  {s}foo
20  +bar  {s}bar
21    
22   bum   bum
23    
24  EOF  EOF
25    
26  open(my $ps, "ps ax |") || die "can't do ps ax: $!";  open(my $ps, "ps ax |") || die "can't do ps ax: $!";
27  while(<$ps>) {  while(<$ps>) {
28          $data .= '+'.$_;          $data .= '{s}'.$_;
29          $data .= ' '.$_;          $data .= $_;
30  }  }
31  close($ps);  close($ps);
32    
# Line 51  my $error_text = ''; Line 53  my $error_text = '';
53  my $selectable_line;  my $selectable_line;
54    
55  for my $l (0 .. $#lines) {  for my $l (0 .. $#lines) {
56          next if (length($lines[$l]) < 2);          if ($lines[$l] !~ s/^{s}//) {
         my $foo = ' ';  
         if ($lines[$l] !~ m/^\s/o) {  
57                  $selectable_line->{$l}++;                  $selectable_line->{$l}++;
                 $foo = '*';  
58          }          }
 #       warn "$l: $foo $lines[$l]\n";  
59  }  }
60    
61  # select first selectable line  # select first selectable line
# Line 69  if ( $selectable_line ) { Line 67  if ( $selectable_line ) {
67    
68  sub full_line {  sub full_line {
69          my $t = shift;          my $t = shift;
70          my $l = length($t);          $t = '' unless defined $t;
71          return $t . (" " x ($scr->cols - length($t)));          return $t . (" " x ($scr->cols - length($t)));
72  }  }
73    
74  sub chunk {  sub chunk {
75          my $t = shift;          my $t = shift;
76          my $o = '';          return unless length($t) > 2;
77          $o = substr($t,1,$scr->cols) if length($t) > 1;          return substr($t,1,$scr->cols);
78          return $o . ( ' ' x ( $scr->cols - length($o) - 1 ) );  }
79    
80    sub redraw_line {
81            my ($l,$line) = @_;
82    
83            if ( defined $selectable_line->{ $l } ) {
84                    $scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();
85            } else {
86                    $scr->at($l,0)->puts( full_line( chunk($line) ) );
87            }
88  }  }
89    
90  sub redraw {  sub redraw {
91          for my $l (0 .. $scr->rows) {          for my $l (0 .. $scr->rows - 3) {
92                  my $line = $lines[ $l + $o ] || '';                  my $line = $lines[ $l + $o ];
93                  next if (length($line) < 2);                  next if (length($line) < 2);
94                  if (substr($line,0,1) !~ m/^\s/o) {                  redraw_line( $l, $line );
                         $scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();  
                 } else {  
                         $scr->at($l,0)->puts( full_line( chunk($line) ) );  
                 }  
95                  last if ($l == $#lines);                  last if ($l == $#lines);
96          }          }
97  }  }
# Line 108  sub status { Line 111  sub status {
111  sub selected {  sub selected {
112          my $d = shift || 0;          my $d = shift || 0;
113    
114          if ( $selectable_line->{ $pos } ) {          my $screen_line = $pos - $o;
                 $scr->at($pos-$o,0)->bold()->puts( chunk($lines[$pos]) )->normal();  
         } else {  
                 $scr->at($pos-$o,0)->puts( chunk($lines[$pos]) )->normal();  
         }  
         $pos += $d;  
115    
116          my $max_row = $scr->rows - 3;          redraw_line( $screen_line, $lines[$pos] );
117    
118          if ($pos < 1) {          my $last_screen_line = $scr->rows - 3;
119                  $error_text = "Already at Begin.";  
120                  $pos = 0;          if ( $d < 0 && $screen_line == 0 ) {
121                    if ( $pos > 0 ) {
122                            $o--;
123                    } else {
124                            $error_text = "Already at Begin.";
125                    }
126                  redraw;                  redraw;
127          } elsif ($pos > $max_row) {          } elsif ( $d > 0 && $screen_line == $last_screen_line ) {
128                  $o = $pos - $max_row;   # put selected line on last                  if ( $pos <= $#lines ) {
129                  $error_text = "Already at End.";                          $o++;
130                    } else {
131                            $error_text = "Already at End.";
132                    }
133                  redraw;                  redraw;
134            } else {
135                    $pos += $d;
136          }          }
137    
138          $scr->at($pos-$o,0)->reverse()->puts(chunk($lines[$pos]))->normal();          my $line = $lines[$pos];
139            if ( defined $selectable_line->{ $pos } ) {
140                    $scr->at($pos - $o,0)->reverse->bold()->puts( full_line( chunk($line) ) )->normal();
141                    $sel_pos = $pos;
142            } else {
143                    $scr->at($pos - $o,0)->reverse->puts( full_line( chunk($line) ) );
144                    $sel_pos = -1;
145            }
146          status;          status;
147  }  }
148    
149  $scr = new Term::Screen || die "can't init Term::Screen";  $scr = new Term::Screen || die "can't init Term::Screen";
150  $scr->clrscr()->noecho();  $scr->clrscr()->noecho();
 $status_text = "let's see does it work?";  
151  redraw;  redraw;
152  selected;  selected;
153    
154  while(my $key = $scr->getch()) {  while(my $key = $scr->getch()) {
155    
         $status_text = sprintf("pos: %-3d sel_pos: %-3d", $pos, $sel_pos );  
         if ( length($key) > 1 ) {  
                 $status_text .= " key: $key";  
         } else {  
                 $status_text .= sprintf("key: %s [%03d][%02x]", $key, ord($key), ord($key) );  
         }  
   
156          $error_text = "";          $error_text = "";
157    
158          if ($key eq 'ku') {          if ($key eq 'ku') {
# Line 154  while(my $key = $scr->getch()) { Line 161  while(my $key = $scr->getch()) {
161                  selected( +1 );                  selected( +1 );
162          }          }
163    
164            $status_text = sprintf("pos: %-3d sel_pos: %-3d top offset: %-3d", $pos, $sel_pos, $o );
165            if ( length($key) > 1 ) {
166                    $status_text .= " key: $key";
167            } else {
168                    $status_text .= sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) );
169            }
170    
171          status;          status;
172    
173            redraw if lc($key) eq 'r';
174    
175          exit if (lc($key) eq 'q');          exit if (lc($key) eq 'q');
176  }  }
177    

Legend:
Removed from v.3  
changed lines
  Added in v.4

  ViewVC Help
Powered by ViewVC 1.1.26