/[iselect]/bin/iselect.pl
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 /bin/iselect.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Thu Oct 25 11:22:18 2007 UTC (16 years, 4 months ago) by dpavlin
Original Path: iselect.pl
File MIME type: text/plain
File size: 2687 byte(s)
finally decided to finish iselect re-implementation in perl
1 #!/usr/bin/perl -w
2
3 use strict;
4 use Term::Screen;
5 use Data::Dump qw/dump/;
6
7 my $data = <<'EOF';
8 First line
9
10 +first selectable
11 + second selectable
12
13 a space....
14
15 ...infinity and beyond
16
17
18 +foo
19 +bar
20
21 bum
22 EOF
23
24 open(my $ps, "ps ax |") || die "can't do ps ax: $!";
25 while(<$ps>) {
26 $data .= '+'.$_;
27 $data .= ' '.$_;
28 }
29 close($ps);
30
31
32 my @lines = split(/\n/, $data);
33
34 my $scr = new Term::Screen || die "can't init Term::Screen";
35 $scr->clrscr()->noecho();
36
37 my $o = 0; # offset in original text
38 my $pos = 0;
39
40 # find which lines are selectable in input file
41 my $selectable_line;
42
43 for my $l (0 .. $#lines) {
44 next if (length($lines[$l]) < 2);
45 my $foo = ' ';
46 if ($lines[$l] !~ m/^\s/o) {
47 $selectable_line->{$l}++;
48 $foo = '*';
49 }
50 warn "$l: $foo $lines[$l]\n";
51 }
52
53 sub full_line {
54 my $t = shift;
55 my $l = length($t);
56 return $t . (" " x ($scr->cols - length($t)));
57 }
58
59 sub chunk {
60 my $t = shift;
61 my $o = '';
62 $o = substr($t,1,$scr->cols) if length($t) > 1;
63 return $o . ( ' ' x ( $scr->cols - length($o) - 1 ) );
64 }
65
66 sub redraw {
67 for my $l (0 .. $scr->rows) {
68 my $line = $lines[ $l + $o ] || '';
69 next if (length($line) < 2);
70 if (substr($line,0,1) !~ m/^\s/o) {
71 $scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();
72 } else {
73 $scr->at($l,0)->puts( full_line( chunk($line) ) );
74 }
75 last if ($l == $#lines);
76 }
77 }
78
79 # default: select first line
80 my $sel_pos = 0;
81 my $status_text = '';
82 my $error_text = '';
83 $pos = 0;
84
85 sub status {
86 my $pcnt = int(($pos || 0) * 100 / ($#lines || 1));
87 my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);
88
89 $scr->at($scr->rows - 2,0)->reverse()->puts(
90 sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text)
91 .$pos_txt)->normal();
92 $scr->at($scr->rows - 1,0)->puts(
93 sprintf('%-'.$scr->cols.'s', $error_text)
94 );
95 }
96
97 sub selected {
98 my $d = shift || return;
99
100 if ( $selectable_line->{ $pos } ) {
101 $scr->at($pos-$o,0)->bold()->puts( chunk($lines[$pos]) )->normal();
102 } else {
103 $scr->at($pos-$o,0)->puts( chunk($lines[$pos]) )->normal();
104 }
105 $pos += $d;
106
107 my $max_row = $scr->rows - 3;
108
109 if ($pos < 1) {
110 $error_text = "Already at Begin.";
111 $pos = 0;
112 redraw;
113 } elsif ($pos > $max_row) {
114 $o = $pos - $max_row; # put selected line on last
115 $error_text = "Already at End.";
116 redraw;
117 }
118
119 $scr->at($pos-$o,0)->reverse()->puts(chunk($lines[$pos]))->normal();
120 status;
121 }
122
123 $status_text = "let's see does it work?";
124 redraw;
125 selected;
126
127 while(my $key = $scr->getch()) {
128
129 $status_text = "key: $key pos: $pos sel_pos: $sel_pos";
130 $error_text = "";
131
132 if ($key eq 'ku') {
133 selected( -1 );
134 } elsif ($key eq 'kd') {
135 selected( +1 );
136 }
137
138 status;
139
140 exit if (lc($key) eq 'q');
141 }
142
143 $scr->clrscr();

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26