/[iselect]/ISelect.pm
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.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 12 - (show annotations)
Thu Oct 25 15:50:56 2007 UTC (11 years, 9 months ago) by dpavlin
File size: 4469 byte(s)
first step into makeing it a module
1 package Term::ISelect;
2
3 use warnings;
4 use strict;
5
6 use Term::Screen;
7 use Carp qw/cluck confess/;
8 use Data::Dump qw/dump/;
9
10 our $VERSION = '0.00';
11
12 =head1 NAME
13
14 Term::ISelect - perl only implementation of Interactive Terminal Selection
15
16 =head1 METHODS
17
18 =cut
19
20 my $scr;
21
22 # leave sane terminal if script dies
23 $SIG{__DIE__} = sub {
24 eval { system('stty sane'); };
25 };
26
27 my @lines;
28
29 my $top_screen_line = 0; # offset in original text
30 my $pos = 0;
31
32 # default: select first line
33 my $sel_pos = 0;
34 my $status_text = '';
35 my $error_text = '';
36
37 my $status_lines = 3;
38
39 my $selectable_line;
40
41 sub full_line {
42 my $t = shift;
43 $t = '' unless defined $t;
44 return $t . (" " x ($scr->cols - length($t)));
45 }
46
47 sub chunk {
48 my $t = shift;
49 cluck "expected line" unless defined $t;
50 return substr($t,0,$scr->cols);
51 }
52
53 sub redraw_line {
54 my ($l,$line) = @_;
55
56 if ( defined $selectable_line->{ $l + $top_screen_line } ) {
57 $scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();
58 } else {
59 $scr->at($l,0)->puts( full_line( chunk($line) ) );
60 }
61 }
62
63 sub redraw {
64 for my $l (0 .. $scr->rows - $status_lines) {
65 my $line = $lines[ $l + $top_screen_line ];
66 redraw_line( $l, $line );
67 last if ($l == $#lines);
68 }
69 selected(0);
70 }
71
72 sub status {
73 my $pcnt = int(($pos || 0) * 100 / ($#lines || 1));
74 my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);
75
76 $scr->at($scr->rows - $status_lines + 1,0)->reverse()->puts(
77 sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text)
78 .$pos_txt)->normal();
79 $scr->at($scr->rows - $status_lines + 2,0)->puts(
80 sprintf('%-'.$scr->cols.'s', $error_text)
81 );
82 }
83
84 sub selected {
85 my $d = shift || 0;
86
87 my $screen_line = $pos - $top_screen_line;
88
89 redraw_line( $screen_line, $lines[$pos] );
90
91 my $last_screen_line = $scr->rows - $status_lines;
92
93 if ( $d < 0 && $screen_line == 0 ) {
94 if ( $pos > 0 ) {
95 $top_screen_line--;
96 $pos--;
97 } else {
98 $error_text = "Already at Begin.";
99 }
100 redraw;
101 } elsif ( $d > 0 && $screen_line == $last_screen_line ) {
102 if ( $pos < $#lines ) {
103 $top_screen_line++;
104 $pos++;
105 } else {
106 $error_text = "Already at End.";
107 }
108 redraw;
109 } else {
110 $pos += $d;
111 }
112
113 my $line = $lines[$pos];
114 if ( defined $selectable_line->{ $pos } ) {
115 $scr->at($pos - $top_screen_line,0)->reverse->bold()->puts( full_line( chunk($line) ) )->normal();
116 $sel_pos = $pos;
117 } else {
118 $scr->at($pos - $top_screen_line,0)->reverse->puts( full_line( chunk($line) ) );
119 $sel_pos = -1;
120 }
121 status;
122 }
123
124
125 =head2 screen
126
127 Term::ISelect->screen(
128 sub {
129 my $line = shift;
130 warn "got line: $line\n";
131 },
132 qw/various lines to be used/,
133 );
134
135 =cut
136
137 sub screen {
138 my $class = shift;
139
140 my $callback = shift;
141 confess "expect callback as first arg" unless ref($callback) eq 'CODE';
142
143 @lines = @_;
144
145 # find which lines are selectable in input file
146 for my $l (0 .. $#lines) {
147 if ($lines[$l] =~ s/^{s}//) {
148 $selectable_line->{$l}++;
149 }
150 }
151
152 # select first selectable line
153 if ( $selectable_line ) {
154 $pos = $sel_pos = (sort { $a <=> $b } keys %$selectable_line)[0];
155 warn "selected first selectable line $sel_pos";
156 }
157
158 $scr = new Term::Screen || die "can't init Term::Screen";
159 $scr->clrscr()->noecho();
160 redraw;
161 selected;
162
163 while(my $key = $scr->getch()) {
164
165 $error_text = "";
166
167 my $lines_on_screen = $scr->rows - $status_lines;
168
169 if ($key eq 'ku') {
170 selected( -1 );
171 } elsif ($key eq 'kd') {
172 selected( +1 );
173 } elsif ($key eq 'pgup' ) {
174 # first line on screen?
175 if ( $pos == $top_screen_line ) {
176 $top_screen_line -= $lines_on_screen;
177 $top_screen_line = 0 if $top_screen_line < 0;
178 redraw;
179 }
180 selected( -( $pos - $top_screen_line ) );
181 } elsif ($key eq 'pgdn' ) {
182 # last line on screen?
183 if ( $pos - $top_screen_line == $lines_on_screen ) {
184 $top_screen_line += $lines_on_screen;
185 $top_screen_line = $#lines - $lines_on_screen if $top_screen_line >= $#lines - $lines_on_screen;
186 redraw;
187 }
188 selected( $top_screen_line + $lines_on_screen - $pos );
189 }
190
191 $status_text = sprintf("pos: %-3d sel_pos: %-3d top_screen_line: %-3d", $pos, $sel_pos, $top_screen_line );
192 if ( length($key) > 1 ) {
193 $status_text .= " key: $key";
194 } else {
195 $status_text .= sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) );
196 }
197
198 # CTRL+L
199 redraw if ord($key) eq 0x0c;
200
201 # Enter
202 if ( ord($key) eq 0x0d && $sel_pos > 0 ) {
203 $error_text = "execute: " . $lines[ $sel_pos ];
204 }
205
206 exit if (lc($key) eq 'q');
207
208 status;
209
210 }
211
212 $scr->clrscr();
213 }
214
215 1;

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26