/[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 3 - (hide annotations)
Thu Oct 25 11:47:40 2007 UTC (16 years, 8 months ago) by dpavlin
Original Path: iselect.pl
File MIME type: text/plain
File size: 3120 byte(s)
correctly position on first selectable line
1 dpavlin 1 #!/usr/bin/perl -w
2    
3     use strict;
4     use Term::Screen;
5     use Data::Dump qw/dump/;
6    
7     my $data = <<'EOF';
8     First line
9    
10     +first selectable
11     + second selectable
12    
13     a space....
14    
15     ...infinity and beyond
16    
17    
18     +foo
19     +bar
20    
21     bum
22     EOF
23    
24     open(my $ps, "ps ax |") || die "can't do ps ax: $!";
25     while(<$ps>) {
26     $data .= '+'.$_;
27     $data .= ' '.$_;
28     }
29     close($ps);
30    
31 dpavlin 2 my $scr;
32 dpavlin 1
33 dpavlin 2 # leave sane terminal if script dies
34     $SIG{__DIE__} = sub {
35     eval { system('stty sane'); };
36     };
37    
38    
39 dpavlin 1 my @lines = split(/\n/, $data);
40    
41     my $o = 0; # offset in original text
42     my $pos = 0;
43    
44 dpavlin 2 # default: select first line
45     my $sel_pos = 0;
46     my $status_text = '';
47     my $error_text = '';
48    
49    
50 dpavlin 1 # find which lines are selectable in input file
51     my $selectable_line;
52    
53     for my $l (0 .. $#lines) {
54     next if (length($lines[$l]) < 2);
55     my $foo = ' ';
56     if ($lines[$l] !~ m/^\s/o) {
57     $selectable_line->{$l}++;
58     $foo = '*';
59     }
60 dpavlin 3 # warn "$l: $foo $lines[$l]\n";
61 dpavlin 1 }
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     my $l = length($t);
73     return $t . (" " x ($scr->cols - length($t)));
74     }
75    
76     sub chunk {
77     my $t = shift;
78     my $o = '';
79     $o = substr($t,1,$scr->cols) if length($t) > 1;
80     return $o . ( ' ' x ( $scr->cols - length($o) - 1 ) );
81     }
82    
83     sub redraw {
84     for my $l (0 .. $scr->rows) {
85     my $line = $lines[ $l + $o ] || '';
86     next if (length($line) < 2);
87     if (substr($line,0,1) !~ m/^\s/o) {
88     $scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();
89     } else {
90     $scr->at($l,0)->puts( full_line( chunk($line) ) );
91     }
92     last if ($l == $#lines);
93     }
94     }
95    
96     sub status {
97     my $pcnt = int(($pos || 0) * 100 / ($#lines || 1));
98     my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);
99    
100     $scr->at($scr->rows - 2,0)->reverse()->puts(
101     sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text)
102     .$pos_txt)->normal();
103     $scr->at($scr->rows - 1,0)->puts(
104     sprintf('%-'.$scr->cols.'s', $error_text)
105     );
106     }
107    
108     sub selected {
109 dpavlin 2 my $d = shift || 0;
110 dpavlin 1
111     if ( $selectable_line->{ $pos } ) {
112     $scr->at($pos-$o,0)->bold()->puts( chunk($lines[$pos]) )->normal();
113     } else {
114     $scr->at($pos-$o,0)->puts( chunk($lines[$pos]) )->normal();
115     }
116     $pos += $d;
117    
118     my $max_row = $scr->rows - 3;
119    
120     if ($pos < 1) {
121     $error_text = "Already at Begin.";
122     $pos = 0;
123     redraw;
124     } elsif ($pos > $max_row) {
125     $o = $pos - $max_row; # put selected line on last
126     $error_text = "Already at End.";
127     redraw;
128     }
129    
130     $scr->at($pos-$o,0)->reverse()->puts(chunk($lines[$pos]))->normal();
131     status;
132     }
133    
134 dpavlin 2 $scr = new Term::Screen || die "can't init Term::Screen";
135     $scr->clrscr()->noecho();
136 dpavlin 1 $status_text = "let's see does it work?";
137     redraw;
138     selected;
139    
140     while(my $key = $scr->getch()) {
141    
142 dpavlin 2 $status_text = sprintf("pos: %-3d sel_pos: %-3d", $pos, $sel_pos );
143     if ( length($key) > 1 ) {
144     $status_text .= " key: $key";
145     } else {
146     $status_text .= sprintf("key: %s [%03d][%02x]", $key, ord($key), ord($key) );
147     }
148    
149 dpavlin 1 $error_text = "";
150    
151     if ($key eq 'ku') {
152     selected( -1 );
153     } elsif ($key eq 'kd') {
154     selected( +1 );
155     }
156    
157     status;
158    
159     exit if (lc($key) eq 'q');
160     }
161    
162     $scr->clrscr();

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26