/[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 9 - (hide annotations)
Thu Oct 25 14:55:00 2007 UTC (16 years, 4 months ago) by dpavlin
Original Path: iselect.pl
File MIME type: text/plain
File size: 4167 byte(s)
make *right* lines selectable
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 dpavlin 8 my $status_lines = 3;
54 dpavlin 2
55 dpavlin 1 # find which lines are selectable in input file
56     my $selectable_line;
57    
58     for my $l (0 .. $#lines) {
59 dpavlin 9 if ($lines[$l] =~ s/^{s}//) {
60 dpavlin 1 $selectable_line->{$l}++;
61     }
62     }
63    
64 dpavlin 2 # select first selectable line
65    
66     if ( $selectable_line ) {
67 dpavlin 3 $pos = $sel_pos = (sort { $a <=> $b } keys %$selectable_line)[0];
68     warn "selected first selectable line $sel_pos";
69 dpavlin 2 }
70    
71 dpavlin 1 sub full_line {
72     my $t = shift;
73 dpavlin 4 $t = '' unless defined $t;
74 dpavlin 1 return $t . (" " x ($scr->cols - length($t)));
75     }
76    
77     sub chunk {
78     my $t = shift;
79 dpavlin 7 cluck "expected line" unless defined $t;
80     return substr($t,0,$scr->cols);
81 dpavlin 1 }
82    
83 dpavlin 4 sub redraw_line {
84     my ($l,$line) = @_;
85    
86     if ( defined $selectable_line->{ $l } ) {
87     $scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();
88     } else {
89     $scr->at($l,0)->puts( full_line( chunk($line) ) );
90     }
91     }
92    
93 dpavlin 1 sub redraw {
94 dpavlin 8 for my $l (0 .. $scr->rows - $status_lines) {
95 dpavlin 6 my $line = $lines[ $l + $top_screen_line ];
96 dpavlin 4 redraw_line( $l, $line );
97 dpavlin 1 last if ($l == $#lines);
98     }
99 dpavlin 7 selected(0);
100 dpavlin 1 }
101    
102     sub status {
103     my $pcnt = int(($pos || 0) * 100 / ($#lines || 1));
104     my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);
105    
106 dpavlin 8 $scr->at($scr->rows - $status_lines + 1,0)->reverse()->puts(
107 dpavlin 1 sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text)
108     .$pos_txt)->normal();
109 dpavlin 8 $scr->at($scr->rows - $status_lines + 2,0)->puts(
110 dpavlin 1 sprintf('%-'.$scr->cols.'s', $error_text)
111     );
112     }
113    
114     sub selected {
115 dpavlin 2 my $d = shift || 0;
116 dpavlin 1
117 dpavlin 6 my $screen_line = $pos - $top_screen_line;
118 dpavlin 1
119 dpavlin 4 redraw_line( $screen_line, $lines[$pos] );
120 dpavlin 1
121 dpavlin 8 my $last_screen_line = $scr->rows - $status_lines;
122 dpavlin 4
123     if ( $d < 0 && $screen_line == 0 ) {
124     if ( $pos > 0 ) {
125 dpavlin 6 $top_screen_line--;
126 dpavlin 5 $pos--;
127 dpavlin 4 } else {
128     $error_text = "Already at Begin.";
129     }
130 dpavlin 1 redraw;
131 dpavlin 4 } elsif ( $d > 0 && $screen_line == $last_screen_line ) {
132 dpavlin 7 if ( $pos < $#lines ) {
133 dpavlin 6 $top_screen_line++;
134 dpavlin 5 $pos++;
135 dpavlin 4 } else {
136     $error_text = "Already at End.";
137     }
138 dpavlin 1 redraw;
139 dpavlin 4 } else {
140     $pos += $d;
141 dpavlin 1 }
142    
143 dpavlin 4 my $line = $lines[$pos];
144     if ( defined $selectable_line->{ $pos } ) {
145 dpavlin 6 $scr->at($pos - $top_screen_line,0)->reverse->bold()->puts( full_line( chunk($line) ) )->normal();
146 dpavlin 4 $sel_pos = $pos;
147     } else {
148 dpavlin 6 $scr->at($pos - $top_screen_line,0)->reverse->puts( full_line( chunk($line) ) );
149 dpavlin 4 $sel_pos = -1;
150     }
151 dpavlin 1 status;
152     }
153    
154 dpavlin 2 $scr = new Term::Screen || die "can't init Term::Screen";
155     $scr->clrscr()->noecho();
156 dpavlin 1 redraw;
157     selected;
158    
159     while(my $key = $scr->getch()) {
160    
161     $error_text = "";
162    
163 dpavlin 8 my $lines_on_screen = $scr->rows - $status_lines;
164 dpavlin 6
165 dpavlin 1 if ($key eq 'ku') {
166     selected( -1 );
167     } elsif ($key eq 'kd') {
168     selected( +1 );
169 dpavlin 6 } elsif ($key eq 'pgup' ) {
170     # first line on screen?
171     if ( $pos == $top_screen_line ) {
172     $top_screen_line -= $lines_on_screen;
173 dpavlin 7 $top_screen_line = 0 if $top_screen_line < 0;
174 dpavlin 6 redraw;
175     }
176 dpavlin 7 selected( -( $pos - $top_screen_line ) );
177 dpavlin 6 } elsif ($key eq 'pgdn' ) {
178     # last line on screen?
179     if ( $pos - $top_screen_line == $lines_on_screen ) {
180     $top_screen_line += $lines_on_screen;
181 dpavlin 7 $top_screen_line = $#lines - $lines_on_screen if $top_screen_line >= $#lines - $lines_on_screen;
182 dpavlin 6 redraw;
183     }
184 dpavlin 7 selected( $top_screen_line + $lines_on_screen - $pos );
185 dpavlin 1 }
186    
187 dpavlin 6 $status_text = sprintf("pos: %-3d sel_pos: %-3d top_screen_line: %-3d", $pos, $sel_pos, $top_screen_line );
188 dpavlin 4 if ( length($key) > 1 ) {
189     $status_text .= " key: $key";
190     } else {
191     $status_text .= sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) );
192     }
193    
194 dpavlin 1 status;
195    
196 dpavlin 7 # CTRL+L
197     redraw if ord($key) eq 0x0c;
198 dpavlin 4
199 dpavlin 1 exit if (lc($key) eq 'q');
200     }
201    
202     $scr->clrscr();

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26