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

Annotation of /bin/iselect.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7 - (hide annotations)
Thu Oct 25 14:11:42 2007 UTC (16 years, 4 months ago) by dpavlin
Original Path: iselect.pl
File MIME type: text/plain
File size: 4077 byte(s)
- fixed pageup/down
- ctrl+l now redraws screen
1 dpavlin 1 #!/usr/bin/perl -w
2    
3     use strict;
4     use Term::Screen;
5 dpavlin 7 use Carp qw/cluck/;
6 dpavlin 1 use Data::Dump qw/dump/;
7    
8     my $data = <<'EOF';
9     First line
10    
11 dpavlin 4 {s}first selectable
12     {s}second selectable
13 dpavlin 1
14     a space....
15    
16     ...infinity and beyond
17    
18    
19 dpavlin 4 {s}foo
20     {s}bar
21 dpavlin 1
22     bum
23 dpavlin 4
24 dpavlin 1 EOF
25    
26     open(my $ps, "ps ax |") || die "can't do ps ax: $!";
27     while(<$ps>) {
28 dpavlin 4 $data .= '{s}'.$_;
29     $data .= $_;
30 dpavlin 1 }
31     close($ps);
32    
33 dpavlin 6 $data .= "\n--EOF--";
34    
35 dpavlin 2 my $scr;
36 dpavlin 1
37 dpavlin 2 # leave sane terminal if script dies
38     $SIG{__DIE__} = sub {
39     eval { system('stty sane'); };
40     };
41    
42    
43 dpavlin 1 my @lines = split(/\n/, $data);
44    
45 dpavlin 6 my $top_screen_line = 0; # offset in original text
46 dpavlin 1 my $pos = 0;
47    
48 dpavlin 2 # default: select first line
49     my $sel_pos = 0;
50     my $status_text = '';
51     my $error_text = '';
52    
53    
54 dpavlin 1 # find which lines are selectable in input file
55     my $selectable_line;
56    
57     for my $l (0 .. $#lines) {
58 dpavlin 4 if ($lines[$l] !~ s/^{s}//) {
59 dpavlin 1 $selectable_line->{$l}++;
60     }
61     }
62    
63 dpavlin 2 # select first selectable line
64    
65     if ( $selectable_line ) {
66 dpavlin 3 $pos = $sel_pos = (sort { $a <=> $b } keys %$selectable_line)[0];
67     warn "selected first selectable line $sel_pos";
68 dpavlin 2 }
69    
70 dpavlin 1 sub full_line {
71     my $t = shift;
72 dpavlin 4 $t = '' unless defined $t;
73 dpavlin 1 return $t . (" " x ($scr->cols - length($t)));
74     }
75    
76     sub chunk {
77     my $t = shift;
78 dpavlin 7 cluck "expected line" unless defined $t;
79     return substr($t,0,$scr->cols);
80 dpavlin 1 }
81    
82 dpavlin 4 sub redraw_line {
83     my ($l,$line) = @_;
84    
85     if ( defined $selectable_line->{ $l } ) {
86     $scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();
87     } else {
88     $scr->at($l,0)->puts( full_line( chunk($line) ) );
89     }
90     }
91    
92 dpavlin 1 sub redraw {
93 dpavlin 4 for my $l (0 .. $scr->rows - 3) {
94 dpavlin 6 my $line = $lines[ $l + $top_screen_line ];
95 dpavlin 4 redraw_line( $l, $line );
96 dpavlin 1 last if ($l == $#lines);
97     }
98 dpavlin 7 selected(0);
99 dpavlin 1 }
100    
101     sub status {
102     my $pcnt = int(($pos || 0) * 100 / ($#lines || 1));
103     my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);
104    
105     $scr->at($scr->rows - 2,0)->reverse()->puts(
106     sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text)
107     .$pos_txt)->normal();
108     $scr->at($scr->rows - 1,0)->puts(
109     sprintf('%-'.$scr->cols.'s', $error_text)
110     );
111     }
112    
113     sub selected {
114 dpavlin 2 my $d = shift || 0;
115 dpavlin 1
116 dpavlin 6 my $screen_line = $pos - $top_screen_line;
117 dpavlin 1
118 dpavlin 4 redraw_line( $screen_line, $lines[$pos] );
119 dpavlin 1
120 dpavlin 4 my $last_screen_line = $scr->rows - 3;
121    
122     if ( $d < 0 && $screen_line == 0 ) {
123     if ( $pos > 0 ) {
124 dpavlin 6 $top_screen_line--;
125 dpavlin 5 $pos--;
126 dpavlin 4 } else {
127     $error_text = "Already at Begin.";
128     }
129 dpavlin 1 redraw;
130 dpavlin 4 } elsif ( $d > 0 && $screen_line == $last_screen_line ) {
131 dpavlin 7 if ( $pos < $#lines ) {
132 dpavlin 6 $top_screen_line++;
133 dpavlin 5 $pos++;
134 dpavlin 4 } else {
135     $error_text = "Already at End.";
136     }
137 dpavlin 1 redraw;
138 dpavlin 4 } else {
139     $pos += $d;
140 dpavlin 1 }
141    
142 dpavlin 4 my $line = $lines[$pos];
143     if ( defined $selectable_line->{ $pos } ) {
144 dpavlin 6 $scr->at($pos - $top_screen_line,0)->reverse->bold()->puts( full_line( chunk($line) ) )->normal();
145 dpavlin 4 $sel_pos = $pos;
146     } else {
147 dpavlin 6 $scr->at($pos - $top_screen_line,0)->reverse->puts( full_line( chunk($line) ) );
148 dpavlin 4 $sel_pos = -1;
149     }
150 dpavlin 1 status;
151     }
152    
153 dpavlin 2 $scr = new Term::Screen || die "can't init Term::Screen";
154     $scr->clrscr()->noecho();
155 dpavlin 1 redraw;
156     selected;
157    
158     while(my $key = $scr->getch()) {
159    
160     $error_text = "";
161    
162 dpavlin 6 my $lines_on_screen = $scr->rows - 3;
163    
164 dpavlin 1 if ($key eq 'ku') {
165     selected( -1 );
166     } elsif ($key eq 'kd') {
167     selected( +1 );
168 dpavlin 6 } elsif ($key eq 'pgup' ) {
169     # first line on screen?
170     if ( $pos == $top_screen_line ) {
171     $top_screen_line -= $lines_on_screen;
172 dpavlin 7 $top_screen_line = 0 if $top_screen_line < 0;
173 dpavlin 6 redraw;
174     }
175 dpavlin 7 selected( -( $pos - $top_screen_line ) );
176 dpavlin 6 } elsif ($key eq 'pgdn' ) {
177     # last line on screen?
178     if ( $pos - $top_screen_line == $lines_on_screen ) {
179     $top_screen_line += $lines_on_screen;
180 dpavlin 7 $top_screen_line = $#lines - $lines_on_screen if $top_screen_line >= $#lines - $lines_on_screen;
181 dpavlin 6 redraw;
182     }
183 dpavlin 7 selected( $top_screen_line + $lines_on_screen - $pos );
184 dpavlin 1 }
185    
186 dpavlin 6 $status_text = sprintf("pos: %-3d sel_pos: %-3d top_screen_line: %-3d", $pos, $sel_pos, $top_screen_line );
187 dpavlin 4 if ( length($key) > 1 ) {
188     $status_text .= " key: $key";
189     } else {
190     $status_text .= sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) );
191     }
192    
193 dpavlin 1 status;
194    
195 dpavlin 7 # CTRL+L
196     redraw if ord($key) eq 0x0c;
197 dpavlin 4
198 dpavlin 1 exit if (lc($key) eq 'q');
199     }
200    
201     $scr->clrscr();

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26