iselect/bin/iselect.pl

#!/usr/bin/perl -w

use strict;
use Term::Screen;
use Carp qw/cluck/;
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);

$data .= "\n--EOF--";

my $scr;

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


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

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

# default: select first line
my $sel_pos = 0;
my $status_text = '';
my $error_text = '';

my $status_lines = 3;

# 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;
        cluck "expected line" unless defined $t;
        return substr($t,0,$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 - $status_lines) {
                my $line = $lines[ $l + $top_screen_line ];
                redraw_line( $l, $line );
                last if ($l == $#lines);
        }
        selected(0);
}

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

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

        my $screen_line = $pos - $top_screen_line;

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

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

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

        my $line = $lines[$pos];
        if ( defined $selectable_line->{ $pos } ) {
                $scr->at($pos - $top_screen_line,0)->reverse->bold()->puts( full_line( chunk($line) ) )->normal();
                $sel_pos = $pos;
        } else {
                $scr->at($pos - $top_screen_line,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 = "";

        my $lines_on_screen = $scr->rows - $status_lines;

        if ($key eq 'ku') {
                selected( -1 );
        } elsif ($key eq 'kd') {
                selected( +1 );
        } elsif ($key eq 'pgup' ) {
                # first line on screen?
                if ( $pos == $top_screen_line ) {
                        $top_screen_line -= $lines_on_screen;
                        $top_screen_line = 0 if $top_screen_line < 0;
                        redraw;
                }
                selected( -( $pos - $top_screen_line ) );
        } elsif ($key eq 'pgdn' ) {
                # last line on screen?
                if ( $pos - $top_screen_line == $lines_on_screen ) {
                        $top_screen_line += $lines_on_screen;
                        $top_screen_line = $#lines - $lines_on_screen if $top_screen_line >= $#lines - $lines_on_screen;
                        redraw;
                }
                selected( $top_screen_line + $lines_on_screen - $pos );
        }

        $status_text = sprintf("pos: %-3d sel_pos: %-3d top_screen_line: %-3d", $pos, $sel_pos, $top_screen_line );
        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;

        # CTRL+L
        redraw if ord($key) eq 0x0c;

        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	7	use Carp qw/cluck/;
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	6	$data .= "\n--EOF--";
34
35	dpavlin	2	my $scr;
36	dpavlin	1
37	dpavlin	2	# leave sane terminal if script dies
38			$SIG{__DIE__} = sub {
39			eval { system('stty sane'); };
40			};
41
42
43	dpavlin	1	my @lines = split(/\n/, $data);
44
45	dpavlin	6	my $top_screen_line = 0; # offset in original text
46	dpavlin	1	my $pos = 0;
47
48	dpavlin	2	# default: select first line
49			my $sel_pos = 0;
50			my $status_text = '';
51			my $error_text = '';
52
53	dpavlin	8	my $status_lines = 3;
54	dpavlin	2
55	dpavlin	1	# find which lines are selectable in input file
56			my $selectable_line;
57
58			for my $l (0 .. $#lines) {
59	dpavlin	4	if ($lines[$l] !~ s/^{s}//) {
60	dpavlin	1	$selectable_line->{$l}++;
61			}
62			}
63
64	dpavlin	2	# select first selectable line
65
66			if ( $selectable_line ) {
67	dpavlin	3	$pos = $sel_pos = (sort { $a <=> $b } keys %$selectable_line)[0];
68			warn "selected first selectable line $sel_pos";
69	dpavlin	2	}
70
71	dpavlin	1	sub full_line {
72			my $t = shift;
73	dpavlin	4	$t = '' unless defined $t;
74	dpavlin	1	return $t . (" " x ($scr->cols - length($t)));
75			}
76
77			sub chunk {
78			my $t = shift;
79	dpavlin	7	cluck "expected line" unless defined $t;
80			return substr($t,0,$scr->cols);
81	dpavlin	1	}
82
83	dpavlin	4	sub redraw_line {
84			my ($l,$line) = @_;
85
86			if ( defined $selectable_line->{ $l } ) {
87			$scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();
88			} else {
89			$scr->at($l,0)->puts( full_line( chunk($line) ) );
90			}
91			}
92
93	dpavlin	1	sub redraw {
94	dpavlin	8	for my $l (0 .. $scr->rows - $status_lines) {
95	dpavlin	6	my $line = $lines[ $l + $top_screen_line ];
96	dpavlin	4	redraw_line( $l, $line );
97	dpavlin	1	last if ($l == $#lines);
98			}
99	dpavlin	7	selected(0);
100	dpavlin	1	}
101
102			sub status {
103			my $pcnt = int(($pos \|\| 0) * 100 / ($#lines \|\| 1));
104			my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);
105
106	dpavlin	8	$scr->at($scr->rows - $status_lines + 1,0)->reverse()->puts(
107	dpavlin	1	sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text)
108			.$pos_txt)->normal();
109	dpavlin	8	$scr->at($scr->rows - $status_lines + 2,0)->puts(
110	dpavlin	1	sprintf('%-'.$scr->cols.'s', $error_text)
111			);
112			}
113
114			sub selected {
115	dpavlin	2	my $d = shift \|\| 0;
116	dpavlin	1
117	dpavlin	6	my $screen_line = $pos - $top_screen_line;
118	dpavlin	1
119	dpavlin	4	redraw_line( $screen_line, $lines[$pos] );
120	dpavlin	1
121	dpavlin	8	my $last_screen_line = $scr->rows - $status_lines;
122	dpavlin	4
123			if ( $d < 0 && $screen_line == 0 ) {
124			if ( $pos > 0 ) {
125	dpavlin	6	$top_screen_line--;
126	dpavlin	5	$pos--;
127	dpavlin	4	} else {
128			$error_text = "Already at Begin.";
129			}
130	dpavlin	1	redraw;
131	dpavlin	4	} elsif ( $d > 0 && $screen_line == $last_screen_line ) {
132	dpavlin	7	if ( $pos < $#lines ) {
133	dpavlin	6	$top_screen_line++;
134	dpavlin	5	$pos++;
135	dpavlin	4	} else {
136			$error_text = "Already at End.";
137			}
138	dpavlin	1	redraw;
139	dpavlin	4	} else {
140			$pos += $d;
141	dpavlin	1	}
142
143	dpavlin	4	my $line = $lines[$pos];
144			if ( defined $selectable_line->{ $pos } ) {
145	dpavlin	6	$scr->at($pos - $top_screen_line,0)->reverse->bold()->puts( full_line( chunk($line) ) )->normal();
146	dpavlin	4	$sel_pos = $pos;
147			} else {
148	dpavlin	6	$scr->at($pos - $top_screen_line,0)->reverse->puts( full_line( chunk($line) ) );
149	dpavlin	4	$sel_pos = -1;
150			}
151	dpavlin	1	status;
152			}
153
154	dpavlin	2	$scr = new Term::Screen \|\| die "can't init Term::Screen";
155			$scr->clrscr()->noecho();
156	dpavlin	1	redraw;
157			selected;
158
159			while(my $key = $scr->getch()) {
160
161			$error_text = "";
162
163	dpavlin	8	my $lines_on_screen = $scr->rows - $status_lines;
164	dpavlin	6
165	dpavlin	1	if ($key eq 'ku') {
166			selected( -1 );
167			} elsif ($key eq 'kd') {
168			selected( +1 );
169	dpavlin	6	} elsif ($key eq 'pgup' ) {
170			# first line on screen?
171			if ( $pos == $top_screen_line ) {
172			$top_screen_line -= $lines_on_screen;
173	dpavlin	7	$top_screen_line = 0 if $top_screen_line < 0;
174	dpavlin	6	redraw;
175			}
176	dpavlin	7	selected( -( $pos - $top_screen_line ) );
177	dpavlin	6	} elsif ($key eq 'pgdn' ) {
178			# last line on screen?
179			if ( $pos - $top_screen_line == $lines_on_screen ) {
180			$top_screen_line += $lines_on_screen;
181	dpavlin	7	$top_screen_line = $#lines - $lines_on_screen if $top_screen_line >= $#lines - $lines_on_screen;
182	dpavlin	6	redraw;
183			}
184	dpavlin	7	selected( $top_screen_line + $lines_on_screen - $pos );
185	dpavlin	1	}
186
187	dpavlin	6	$status_text = sprintf("pos: %-3d sel_pos: %-3d top_screen_line: %-3d", $pos, $sel_pos, $top_screen_line );
188	dpavlin	4	if ( length($key) > 1 ) {
189			$status_text .= " key: $key";
190			} else {
191			$status_text .= sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) );
192			}
193
194	dpavlin	1	status;
195
196	dpavlin	7	# CTRL+L
197			redraw if ord($key) eq 0x0c;
198	dpavlin	4
199	dpavlin	1	exit if (lc($key) eq 'q');
200			}
201
202			$scr->clrscr();