"Fossies" - the Fresh Open Source Software Archive 
Member "xterm-379/vttests/cursor.pl" (3 Dec 2007, 4502 Bytes) of package /linux/misc/xterm-379.tgz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "cursor.pl" see the
Fossies "Dox" file reference documentation.
1 #!/usr/bin/env perl
2 # $XTermId: cursor.pl,v 1.8 2007/12/03 00:56:29 tom Exp $
3 # -----------------------------------------------------------------------------
4 # Copyright 2007 by Thomas E. Dickey
5 #
6 # All Rights Reserved
7 #
8 # Permission is hereby granted, free of charge, to any person obtaining a
9 # copy of this software and associated documentation files (the
10 # "Software"), to deal in the Software without restriction, including
11 # without limitation the rights to use, copy, modify, merge, publish,
12 # distribute, sublicense, and/or sell copies of the Software, and to
13 # permit persons to whom the Software is furnished to do so, subject to
14 # the following conditions:
15 #
16 # The above copyright notice and this permission notice shall be included
17 # in all copies or substantial portions of the Software.
18 #
19 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
20 # OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
21 # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
22 # IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
23 # CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
24 # TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
25 # SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
26 #
27 # Except as contained in this notice, the name(s) of the above copyright
28 # holders shall not be used in advertising or otherwise to promote the
29 # sale, use or other dealings in this Software without prior written
30 # authorization.
31 # -----------------------------------------------------------------------------
32 # Read a file (or pipe from a program) and move the cursor around the screen
33 # in response to h,j,k,l commands so we can see the colors that affect the
34 # cursor. Exit on 'q'. Do forward/backward paging to \E[J markers
35 # in the data with n,p. Ignore other characters.
36 #
37 # Use this rather than, say, a curses program since it is much easier to
38 # construct a particular screen using 'script' or echo commands than to
39 # guarantee the same screen with curses' optimization.
40
41 use strict;
42
43 use Getopt::Std;
44 use IO::Handle;
45
46 our ( $opt_x );
47 our ( $row_max, $col_max );
48 our $old_stty;
49 our $text_blob;
50 our $text_1st;
51 our $text_2nd;
52 our $text_chop = qw/^\x1b\[H\x1b\[J/;
53 our $text_mark = "\x1b[H\x1b[J";
54
55 sub get_screensize() {
56 my @reply = `resize -u`;
57 chomp @reply;
58 for my $n (0..$#reply) {
59 if ( $reply[$n] =~ /=/ ) {
60 my $value = $reply[$n];
61 $value =~ s/^.*=//;
62 if ( $reply[$n] =~ /^COLUMNS.*/ ) {
63 $col_max = $value;
64 } else {
65 $row_max = $value;
66 }
67 }
68 }
69 }
70
71 sub end_cursor($) {
72 close TTY;
73 system "stty $old_stty";
74 print $_[0];
75 exit;
76 }
77
78 sub begin_cursor() {
79 open TTY, "+</dev/tty" or end_cursor("Cannot open /dev/tty\n");
80 autoflush TTY 1;
81 $old_stty=`stty -g`;
82 system "stty raw -echo min 0 time 1";
83 }
84
85 sub beep() {
86 printf "\007";
87 }
88
89 sub get_char() {
90 my $reply;
91 do {
92 $reply=<TTY>;
93 # printf "get_char\r\n";
94 } while (not defined $reply);
95 return $reply;
96 }
97
98 sub move_to($$) {
99 my $y = $_[0];
100 my $x = $_[1];
101 if ( $y < 0 ) {
102 $y = 0;
103 } elsif ( $x < 0 ) {
104 $x = 0;
105 } elsif ( $y >= $row_max ) {
106 $y -= 1;
107 } elsif ( $x >= $col_max ) {
108 $x -= 1;
109 } else {
110 printf "\x1b[%d;%dH", $y + 1, $x + 1;
111 }
112 return ( $y, $x );
113 }
114
115 sub vxt_cursor() {
116 my $ch;
117 my $x = 0;
118 my $y = 0;
119 my @pages = split $text_chop, $text_blob;
120 my $page = 1;
121
122 my_page:
123 move_to ($y, $x);
124 printf "%s", $text_mark . $pages[$page];
125 move_to ($y, $x);
126 my_loop:
127 for (;;) {
128 $ch = get_char();
129 if ( $ch eq "q") {
130 last my_loop;
131 } elsif ( $ch eq "h" ) {
132 ($y, $x) = move_to($y, $x - 1);
133 } elsif ( $ch eq "j" ) {
134 ($y, $x) = move_to($y + 1, $x);
135 } elsif ( $ch eq "k" ) {
136 ($y, $x) = move_to($y - 1, $x);
137 } elsif ( $ch eq "l" ) {
138 ($y, $x) = move_to($y, $x + 1);
139 } elsif ( $ch eq "n" ) {
140 if ( $page < $#pages ) {
141 $page += 1;
142 goto my_page;
143 } else {
144 beep();
145 }
146 } elsif ( $ch eq "p" ) {
147 if ( $page > 1 ) {
148 $page -= 1;
149 goto my_page;
150 } else {
151 beep();
152 }
153 } else {
154 beep();
155 # printf "got:%s\r\n", $ch;
156 }
157 }
158 }
159
160 sub load_text($) {
161 my $source = $_[0];
162 my $text;
163 if ( defined($opt_x) ) {
164 $text = `$source`;
165 } else {
166 $text = `cat $source`;
167 }
168 $text =~ s/\n/\r\n/g;
169 if ( $text !~ $text_chop ) {
170 $text = $text_mark . $text;
171 }
172 $text_blob = $text_blob . $text;
173 }
174
175 &getopts('x') || die();
176
177 while ( $#ARGV >= 0 ) {
178 load_text ( shift @ARGV );
179 }
180
181 get_screensize();
182 begin_cursor();
183 vxt_cursor();
184 end_cursor("Done\n");