1 |
#!/usr/bin/perl -w |
#!/usr/bin/perl -w |
2 |
|
|
3 |
use strict; |
use strict; |
4 |
use Term::Screen; |
|
5 |
|
use blib; |
6 |
|
|
7 |
|
use Term::ISelect; |
8 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
9 |
|
|
10 |
my $data = <<'EOF'; |
my $data = <<'EOF'; |
11 |
First line |
First line |
12 |
|
|
13 |
+first selectable |
{s}first selectable |
14 |
+ second selectable |
{s}second selectable |
15 |
|
|
16 |
a space.... |
a space.... |
17 |
|
|
18 |
...infinity and beyond |
...infinity and beyond |
19 |
|
|
20 |
|
|
21 |
+foo |
{s}foo |
22 |
+bar |
{s}bar |
23 |
|
|
24 |
bum |
bum |
|
EOF |
|
|
|
|
|
open(my $ps, "ps ax |") || die "can't do ps ax: $!"; |
|
|
while(<$ps>) { |
|
|
$data .= '+'.$_; |
|
|
$data .= ' '.$_; |
|
|
} |
|
|
close($ps); |
|
|
|
|
|
my $scr; |
|
|
|
|
|
# leave sane terminal if script dies |
|
|
$SIG{__DIE__} = sub { |
|
|
eval { system('stty sane'); }; |
|
|
}; |
|
|
|
|
25 |
|
|
26 |
my @lines = split(/\n/, $data); |
EOF |
27 |
|
|
28 |
my $o = 0; # offset in original text |
$data .= ( rand(10) < 5 ? '{s}' : '' ) . "foobar $_\n" foreach ( 1 .. 300 ); |
|
my $pos = 0; |
|
29 |
|
|
30 |
# default: select first line |
$data .= "\n--EOF--"; |
|
my $sel_pos = 0; |
|
|
my $status_text = ''; |
|
|
my $error_text = ''; |
|
|
|
|
|
|
|
|
# find which lines are selectable in input file |
|
|
my $selectable_line; |
|
|
|
|
|
for my $l (0 .. $#lines) { |
|
|
next if (length($lines[$l]) < 2); |
|
|
my $foo = ' '; |
|
|
if ($lines[$l] !~ m/^\s/o) { |
|
|
$selectable_line->{$l}++; |
|
|
$foo = '*'; |
|
|
} |
|
|
# warn "$l: $foo $lines[$l]\n"; |
|
|
} |
|
|
|
|
|
# select first selectable line |
|
|
|
|
|
if ( $selectable_line ) { |
|
|
$pos = $sel_pos = (sort { $a <=> $b } keys %$selectable_line)[0]; |
|
|
warn "selected first selectable line $sel_pos"; |
|
|
} |
|
|
|
|
|
sub full_line { |
|
|
my $t = shift; |
|
|
my $l = length($t); |
|
|
return $t . (" " x ($scr->cols - length($t))); |
|
|
} |
|
|
|
|
|
sub chunk { |
|
|
my $t = shift; |
|
|
my $o = ''; |
|
|
$o = substr($t,1,$scr->cols) if length($t) > 1; |
|
|
return $o . ( ' ' x ( $scr->cols - length($o) - 1 ) ); |
|
|
} |
|
|
|
|
|
sub redraw { |
|
|
for my $l (0 .. $scr->rows) { |
|
|
my $line = $lines[ $l + $o ] || ''; |
|
|
next if (length($line) < 2); |
|
|
if (substr($line,0,1) !~ m/^\s/o) { |
|
|
$scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal(); |
|
|
} else { |
|
|
$scr->at($l,0)->puts( full_line( chunk($line) ) ); |
|
|
} |
|
|
last if ($l == $#lines); |
|
|
} |
|
|
} |
|
|
|
|
|
sub status { |
|
|
my $pcnt = int(($pos || 0) * 100 / ($#lines || 1)); |
|
|
my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt); |
|
31 |
|
|
32 |
$scr->at($scr->rows - 2,0)->reverse()->puts( |
my @lines = split(/\n/, $data); |
33 |
sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text) |
warn "lines = ", dump( @lines ); |
|
.$pos_txt)->normal(); |
|
|
$scr->at($scr->rows - 1,0)->puts( |
|
|
sprintf('%-'.$scr->cols.'s', $error_text) |
|
|
); |
|
|
} |
|
|
|
|
|
sub selected { |
|
|
my $d = shift || 0; |
|
|
|
|
|
if ( $selectable_line->{ $pos } ) { |
|
|
$scr->at($pos-$o,0)->bold()->puts( chunk($lines[$pos]) )->normal(); |
|
|
} else { |
|
|
$scr->at($pos-$o,0)->puts( chunk($lines[$pos]) )->normal(); |
|
|
} |
|
|
$pos += $d; |
|
|
|
|
|
my $max_row = $scr->rows - 3; |
|
|
|
|
|
if ($pos < 1) { |
|
|
$error_text = "Already at Begin."; |
|
|
$pos = 0; |
|
|
redraw; |
|
|
} elsif ($pos > $max_row) { |
|
|
$o = $pos - $max_row; # put selected line on last |
|
|
$error_text = "Already at End."; |
|
|
redraw; |
|
|
} |
|
|
|
|
|
$scr->at($pos-$o,0)->reverse()->puts(chunk($lines[$pos]))->normal(); |
|
|
status; |
|
|
} |
|
|
|
|
|
$scr = new Term::Screen || die "can't init Term::Screen"; |
|
|
$scr->clrscr()->noecho(); |
|
|
$status_text = "let's see does it work?"; |
|
|
redraw; |
|
|
selected; |
|
|
|
|
|
while(my $key = $scr->getch()) { |
|
|
|
|
|
$status_text = sprintf("pos: %-3d sel_pos: %-3d", $pos, $sel_pos ); |
|
|
if ( length($key) > 1 ) { |
|
|
$status_text .= " key: $key"; |
|
|
} else { |
|
|
$status_text .= sprintf("key: %s [%03d][%02x]", $key, ord($key), ord($key) ); |
|
|
} |
|
|
|
|
|
$error_text = ""; |
|
|
|
|
|
if ($key eq 'ku') { |
|
|
selected( -1 ); |
|
|
} elsif ($key eq 'kd') { |
|
|
selected( +1 ); |
|
|
} |
|
|
|
|
|
status; |
|
34 |
|
|
35 |
exit if (lc($key) eq 'q'); |
my $iselect = Term::ISelect->new({ |
36 |
} |
lines => [ @lines ], |
37 |
|
}); |
38 |
|
|
39 |
|
$iselect->loop( |
40 |
|
sub { |
41 |
|
warn "## ",dump(@_); |
42 |
|
}, |
43 |
|
); |
44 |
|
|
|
$scr->clrscr(); |
|