/[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 5 - (hide annotations)
Thu Oct 25 13:04:52 2007 UTC (16 years, 4 months ago) by dpavlin
Original Path: iselect.pl
File MIME type: text/plain
File size: 3331 byte(s)
move selected line on scroll
1 dpavlin 1 #!/usr/bin/perl -w
2    
3     use strict;
4     use Term::Screen;
5 dpavlin 4 use Carp qw/confess/;
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 2 my $scr;
34 dpavlin 1
35 dpavlin 2 # leave sane terminal if script dies
36     $SIG{__DIE__} = sub {
37     eval { system('stty sane'); };
38     };
39    
40    
41 dpavlin 1 my @lines = split(/\n/, $data);
42    
43     my $o = 0; # offset in original text
44     my $pos = 0;
45    
46 dpavlin 2 # default: select first line
47     my $sel_pos = 0;
48     my $status_text = '';
49     my $error_text = '';
50    
51    
52 dpavlin 1 # find which lines are selectable in input file
53     my $selectable_line;
54    
55     for my $l (0 .. $#lines) {
56 dpavlin 4 if ($lines[$l] !~ s/^{s}//) {
57 dpavlin 1 $selectable_line->{$l}++;
58     }
59     }
60    
61 dpavlin 2 # select first selectable line
62    
63     if ( $selectable_line ) {
64 dpavlin 3 $pos = $sel_pos = (sort { $a <=> $b } keys %$selectable_line)[0];
65     warn "selected first selectable line $sel_pos";
66 dpavlin 2 }
67    
68 dpavlin 1 sub full_line {
69     my $t = shift;
70 dpavlin 4 $t = '' unless defined $t;
71 dpavlin 1 return $t . (" " x ($scr->cols - length($t)));
72     }
73    
74     sub chunk {
75     my $t = shift;
76 dpavlin 4 return unless length($t) > 2;
77     return substr($t,1,$scr->cols);
78 dpavlin 1 }
79    
80 dpavlin 4 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 dpavlin 1 sub redraw {
91 dpavlin 4 for my $l (0 .. $scr->rows - 3) {
92     my $line = $lines[ $l + $o ];
93 dpavlin 1 next if (length($line) < 2);
94 dpavlin 4 redraw_line( $l, $line );
95 dpavlin 1 last if ($l == $#lines);
96     }
97     }
98    
99     sub status {
100     my $pcnt = int(($pos || 0) * 100 / ($#lines || 1));
101     my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);
102    
103     $scr->at($scr->rows - 2,0)->reverse()->puts(
104     sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text)
105     .$pos_txt)->normal();
106     $scr->at($scr->rows - 1,0)->puts(
107     sprintf('%-'.$scr->cols.'s', $error_text)
108     );
109     }
110    
111     sub selected {
112 dpavlin 2 my $d = shift || 0;
113 dpavlin 1
114 dpavlin 4 my $screen_line = $pos - $o;
115 dpavlin 1
116 dpavlin 4 redraw_line( $screen_line, $lines[$pos] );
117 dpavlin 1
118 dpavlin 4 my $last_screen_line = $scr->rows - 3;
119    
120     if ( $d < 0 && $screen_line == 0 ) {
121     if ( $pos > 0 ) {
122     $o--;
123 dpavlin 5 $pos--;
124 dpavlin 4 } else {
125     $error_text = "Already at Begin.";
126     }
127 dpavlin 1 redraw;
128 dpavlin 4 } elsif ( $d > 0 && $screen_line == $last_screen_line ) {
129     if ( $pos <= $#lines ) {
130     $o++;
131 dpavlin 5 $pos++;
132 dpavlin 4 } else {
133     $error_text = "Already at End.";
134     }
135 dpavlin 1 redraw;
136 dpavlin 4 } else {
137     $pos += $d;
138 dpavlin 1 }
139    
140 dpavlin 4 my $line = $lines[$pos];
141     if ( defined $selectable_line->{ $pos } ) {
142     $scr->at($pos - $o,0)->reverse->bold()->puts( full_line( chunk($line) ) )->normal();
143     $sel_pos = $pos;
144     } else {
145     $scr->at($pos - $o,0)->reverse->puts( full_line( chunk($line) ) );
146     $sel_pos = -1;
147     }
148 dpavlin 1 status;
149     }
150    
151 dpavlin 2 $scr = new Term::Screen || die "can't init Term::Screen";
152     $scr->clrscr()->noecho();
153 dpavlin 1 redraw;
154     selected;
155    
156     while(my $key = $scr->getch()) {
157    
158     $error_text = "";
159    
160     if ($key eq 'ku') {
161     selected( -1 );
162     } elsif ($key eq 'kd') {
163     selected( +1 );
164     }
165    
166 dpavlin 4 $status_text = sprintf("pos: %-3d sel_pos: %-3d top offset: %-3d", $pos, $sel_pos, $o );
167     if ( length($key) > 1 ) {
168     $status_text .= " key: $key";
169     } else {
170     $status_text .= sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) );
171     }
172    
173 dpavlin 1 status;
174    
175 dpavlin 4 redraw if lc($key) eq 'r';
176    
177 dpavlin 1 exit if (lc($key) eq 'q');
178     }
179    
180     $scr->clrscr();

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26