/[iselect]/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 /iselect.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4 - (hide annotations)
Thu Oct 25 12:45:18 2007 UTC (16 years, 4 months ago) by dpavlin
File MIME type: text/plain
File size: 3309 byte(s)
- more cleanup
- selected lines now use {s} as does iselect
- some support for scrolling
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     } else {
124     $error_text = "Already at Begin.";
125     }
126 dpavlin 1 redraw;
127 dpavlin 4 } elsif ( $d > 0 && $screen_line == $last_screen_line ) {
128     if ( $pos <= $#lines ) {
129     $o++;
130     } 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     $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 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     if ($key eq 'ku') {
159     selected( -1 );
160     } elsif ($key eq 'kd') {
161     selected( +1 );
162     }
163    
164 dpavlin 4 $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 dpavlin 1 status;
172    
173 dpavlin 4 redraw if lc($key) eq 'r';
174    
175 dpavlin 1 exit if (lc($key) eq 'q');
176     }
177    
178     $scr->clrscr();

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26