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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26