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

Annotation of /ISelect.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 12 - (hide annotations)
Thu Oct 25 15:50:56 2007 UTC (11 years, 6 months ago) by dpavlin
File size: 4469 byte(s)
first step into makeing it a module
1 dpavlin 12 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