/[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

Contents of /iselect.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5 - (show annotations)
Thu Oct 25 13:04:52 2007 UTC (16 years, 4 months ago) by dpavlin
File MIME type: text/plain
File size: 3331 byte(s)
move selected line on scroll
1 #!/usr/bin/perl -w
2
3 use strict;
4 use Term::Screen;
5 use Carp qw/confess/;
6 use Data::Dump qw/dump/;
7
8 my $data = <<'EOF';
9 First line
10
11 {s}first selectable
12 {s}second selectable
13
14 a space....
15
16 ...infinity and beyond
17
18
19 {s}foo
20 {s}bar
21
22 bum
23
24 EOF
25
26 open(my $ps, "ps ax |") || die "can't do ps ax: $!";
27 while(<$ps>) {
28 $data .= '{s}'.$_;
29 $data .= $_;
30 }
31 close($ps);
32
33 my $scr;
34
35 # leave sane terminal if script dies
36 $SIG{__DIE__} = sub {
37 eval { system('stty sane'); };
38 };
39
40
41 my @lines = split(/\n/, $data);
42
43 my $o = 0; # offset in original text
44 my $pos = 0;
45
46 # default: select first line
47 my $sel_pos = 0;
48 my $status_text = '';
49 my $error_text = '';
50
51
52 # find which lines are selectable in input file
53 my $selectable_line;
54
55 for my $l (0 .. $#lines) {
56 if ($lines[$l] !~ s/^{s}//) {
57 $selectable_line->{$l}++;
58 }
59 }
60
61 # select first selectable line
62
63 if ( $selectable_line ) {
64 $pos = $sel_pos = (sort { $a <=> $b } keys %$selectable_line)[0];
65 warn "selected first selectable line $sel_pos";
66 }
67
68 sub full_line {
69 my $t = shift;
70 $t = '' unless defined $t;
71 return $t . (" " x ($scr->cols - length($t)));
72 }
73
74 sub chunk {
75 my $t = shift;
76 return unless length($t) > 2;
77 return substr($t,1,$scr->cols);
78 }
79
80 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 sub redraw {
91 for my $l (0 .. $scr->rows - 3) {
92 my $line = $lines[ $l + $o ];
93 next if (length($line) < 2);
94 redraw_line( $l, $line );
95 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 my $d = shift || 0;
113
114 my $screen_line = $pos - $o;
115
116 redraw_line( $screen_line, $lines[$pos] );
117
118 my $last_screen_line = $scr->rows - 3;
119
120 if ( $d < 0 && $screen_line == 0 ) {
121 if ( $pos > 0 ) {
122 $o--;
123 $pos--;
124 } else {
125 $error_text = "Already at Begin.";
126 }
127 redraw;
128 } elsif ( $d > 0 && $screen_line == $last_screen_line ) {
129 if ( $pos <= $#lines ) {
130 $o++;
131 $pos++;
132 } else {
133 $error_text = "Already at End.";
134 }
135 redraw;
136 } else {
137 $pos += $d;
138 }
139
140 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 status;
149 }
150
151 $scr = new Term::Screen || die "can't init Term::Screen";
152 $scr->clrscr()->noecho();
153 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 $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 status;
174
175 redraw if lc($key) eq 'r';
176
177 exit if (lc($key) eq 'q');
178 }
179
180 $scr->clrscr();

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26