iselect/bin/iselect.pl

#!/usr/bin/perl -w

use strict;
use Term::Screen;
use Carp qw/confess/;
use Data::Dump qw/dump/;

my $data = <<'EOF';
 First line

{s}first selectable
{s}second selectable

 a space....

                                    ...infinity and beyond


{s}foo
{s}bar

 bum

EOF

open(my $ps, "ps ax |") || die "can't do ps ax: $!";
while(<$ps>) {
        $data .= '{s}'.$_;
        $data .= $_;
}
close($ps);

my $scr;

# leave sane terminal if script dies
$SIG{__DIE__} = sub {
    eval { system('stty sane'); };
};


my @lines = split(/\n/, $data);

my $o = 0;      # offset in original text
my $pos = 0;

# default: select first line
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) {
        if ($lines[$l] !~ s/^{s}//) {
                $selectable_line->{$l}++;
        }
}

# 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;
        $t = '' unless defined $t;
        return $t . (" " x ($scr->cols - length($t)));
}

sub chunk {
        my $t = shift;
        return unless length($t) > 2;
        return substr($t,1,$scr->cols);
}

sub redraw_line {
        my ($l,$line) = @_;

        if ( defined $selectable_line->{ $l } ) {
                $scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();
        } else {
                $scr->at($l,0)->puts( full_line( chunk($line) ) );
        }
}

sub redraw {
        for my $l (0 .. $scr->rows - 3) {
                my $line = $lines[ $l + $o ];
                next if (length($line) < 2);
                redraw_line( $l, $line );
                last if ($l == $#lines);
        }
}

sub status {
        my $pcnt = int(($pos || 0) * 100 / ($#lines || 1));
        my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);
        
        $scr->at($scr->rows - 2,0)->reverse()->puts(
                sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text)
        .$pos_txt)->normal();
        $scr->at($scr->rows - 1,0)->puts(
                sprintf('%-'.$scr->cols.'s', $error_text)
        );
}

sub selected {
        my $d = shift || 0;

        my $screen_line = $pos - $o;

        redraw_line( $screen_line, $lines[$pos] );

        my $last_screen_line = $scr->rows - 3;

        if ( $d < 0 && $screen_line == 0 ) {
                if ( $pos > 0 ) {
                        $o--;
                } else {
                        $error_text = "Already at Begin.";
                }
                redraw;
        } elsif ( $d > 0 && $screen_line == $last_screen_line ) {
                if ( $pos <= $#lines ) {
                        $o++;
                } else {
                        $error_text = "Already at End.";
                }
                redraw;
        } else {
                $pos += $d;
        }

        my $line = $lines[$pos];
        if ( defined $selectable_line->{ $pos } ) {
                $scr->at($pos - $o,0)->reverse->bold()->puts( full_line( chunk($line) ) )->normal();
                $sel_pos = $pos;
        } else {
                $scr->at($pos - $o,0)->reverse->puts( full_line( chunk($line) ) );
                $sel_pos = -1;
        }
        status;
}

$scr = new Term::Screen || die "can't init Term::Screen";
$scr->clrscr()->noecho();
redraw;
selected;

while(my $key = $scr->getch()) {

        $error_text = "";

        if ($key eq 'ku') {
                selected( -1 );
        } elsif ($key eq 'kd') {
                selected( +1 );
        }

        $status_text = sprintf("pos: %-3d sel_pos: %-3d top offset: %-3d", $pos, $sel_pos, $o );
        if ( length($key) > 1 ) {
                $status_text .= " key: $key";
        } else {
                $status_text .= sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) );
        }

        status;

        redraw if lc($key) eq 'r';

        exit if (lc($key) eq 'q');
}

$scr->clrscr();
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();