"Fossies" - the Fresh Open Source Software Archive 
Member "xterm-379/vttests/insdelln.pl" (10 Oct 2022, 7306 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 "insdelln.pl" see the
Fossies "Dox" file reference documentation and the latest
Fossies "Diffs" side-by-side code changes report:
377_vs_379.
1 #!/usr/bin/env perl
2 # $XTermId: insdelln.pl,v 1.10 2022/10/10 17:05:38 tom Exp $
3 # -----------------------------------------------------------------------------
4 # this file is part of xterm
5 #
6 # Copyright 2009,2022 by Thomas E. Dickey
7 #
8 # All Rights Reserved
9 #
10 # Permission is hereby granted, free of charge, to any person obtaining a
11 # copy of this software and associated documentation files (the
12 # "Software"), to deal in the Software without restriction, including
13 # without limitation the rights to use, copy, modify, merge, publish,
14 # distribute, sublicense, and/or sell copies of the Software, and to
15 # permit persons to whom the Software is furnished to do so, subject to
16 # the following conditions:
17 #
18 # The above copyright notice and this permission notice shall be included
19 # in all copies or substantial portions of the Software.
20 #
21 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
22 # OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
23 # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
24 # IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
25 # CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
26 # TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
27 # SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
28 #
29 # Except as contained in this notice, the name(s) of the above copyright
30 # holders shall not be used in advertising or otherwise to promote the
31 # sale, use or other dealings in this Software without prior written
32 # authorization.
33 # -----------------------------------------------------------------------------
34 # Tests insert/delete-line feature in xterm. This applies only to the
35 # visible screen (saved-lines are unaffected).
36 #
37 # TODO:
38 # add option to wrap the test-pattern
39 # use scrolling-margins to help fill-in a chunk
40 use strict;
41 use warnings;
42
43 use Getopt::Std;
44
45 # do this so output from successive calls to this script won't get in the
46 # wrong order:
47 use IO::Handle;
48 STDERR->autoflush(1);
49 STDOUT->autoflush(1);
50
51 our ( $opt_c, $opt_n, $opt_r, $opt_w );
52 our ( $lineno, $test_string, $term_height, $term_width );
53
54 our @resize;
55
56 sub read_resize($) {
57 my $field = shift;
58 my $result = shift;
59 if ( $#resize < 0 ) {
60 open( FP, "resize -u |" ) or exit $!;
61 @resize = <FP>;
62 chomp @resize;
63 close(FP);
64 }
65 for my $n ( 0 .. $#resize ) {
66 if ( $resize[$n] =~ /^$field=/ ) {
67 $result = $resize[$n];
68 $result =~ s/^[^=]*=//;
69 $result =~ s/;.*//;
70 last;
71 }
72 }
73 return $result;
74 }
75
76 # returns the number of rows in the screen
77 sub screen_height() {
78 return &read_resize( "LINES", 24 );
79 }
80
81 # returns the number of columns in the screen
82 sub screen_width() {
83 return &read_resize( "COLUMNS", 80 );
84 }
85
86 sub set_color($) {
87 my $code = $_[0];
88 if ( defined($opt_c) ) {
89 if ( $code == 3 ) {
90 printf "\x1b[1;33;42m"; # yellow-on-green
91 }
92 elsif ( $code == 2 ) {
93 printf "\x1b[0;31;45m"; # red-on-magenta
94 }
95 elsif ( $code == 1 ) {
96 printf "\x1b[0;36;44m"; # cyan-on-blue
97 }
98 else {
99 printf "\x1b[0;39;49m";
100 }
101 }
102 }
103
104 # returns a string of two-column characters given an ASCII alpha/numeric string
105 sub double_cells($) {
106 my $value = $_[0];
107 $value =~ s/ / /g;
108 pack(
109 "U*",
110 map {
111 ( $_ <= 32 || $_ > 127 ) # if non-ASCII character...
112 ? 32 # ...just show a blank
113 : ( 0xff00 + ( $_ - 32 ) ) # map to "Fullwidth Form"
114 } unpack( "C*", $value )
115 ); # unpack unsigned-char characters
116 }
117
118 sub clear_screen() {
119 upper_left();
120 printf "\x1b[J";
121 }
122
123 sub clr_to_eol() {
124 printf "\x1b[K";
125 }
126
127 sub lower_left() {
128 printf "\x1b[%dH", $term_height;
129 }
130
131 sub upper_left() {
132 printf "\x1b[H";
133 }
134
135 sub move_to($) {
136 printf "\x1b[%dG", $_[0] + 1;
137 }
138
139 sub insert_lines($) {
140
141 #lower_left;
142 if ( $_[0] ) {
143 printf "\x1b[%dL", $_[0];
144 }
145 else {
146 printf "\x1b[L";
147 }
148 }
149
150 sub delete_lines($) {
151 if ( $_[0] ) {
152 printf "\x1b[%dM", $_[0];
153 }
154 else {
155 printf "\x1b[M";
156 }
157 }
158
159 sub delete_char() {
160 set_color(2);
161 printf "\x1b[%dP", 1;
162 set_color(1);
163 }
164
165 sub insert_once($) {
166 my $text = shift;
167 set_color(2);
168 printf "\x1b[%d@", length($text);
169 write_chars($text);
170 }
171
172 sub insert_mode($) {
173 set_color(2);
174 printf "\x1b[%dP", length( $_[0] );
175 printf "\x1b[4h";
176 write_chars( $_[0] );
177 printf "\x1b[4l";
178 }
179
180 sub write_chars($) {
181 set_color(3);
182 printf "%s", $_[0];
183 set_color(1);
184 }
185
186 # vary the starting point of each line, to make a more interesting pattern
187 sub starts_of($) {
188 my $value = $_[0];
189 if ( defined($opt_w) ) {
190
191 # 0,1,1,2,2,3,3,...
192 $value = ( ( $value + 1 ) / 2 ) % length($test_string);
193 }
194 else {
195 $value %= length($test_string);
196 }
197 return $value;
198 }
199
200 # write the text for the given line-number
201 sub testit($) {
202 my $number = $_[0];
203 my $length = $term_width;
204
205 # use delete-lines to "pull" the screen up, like scrolling.
206 select( undef, undef, undef, 0.1 );
207 if ( ( ( $number / $term_height ) % 2 ) != 0 ) {
208 upper_left;
209 insert_lines(1);
210 }
211 else {
212 upper_left;
213 delete_lines(1);
214 lower_left;
215 }
216 if ( defined($opt_n) ) {
217 printf "%5d ", $number % 99999;
218 $length -= 6;
219 }
220
221 # if we're printing double-column characters, we have half as much
222 # space effectively - but don't forget the remainder, so we can push
223 # the characters by single-columns.
224 if ( defined($opt_c) ) {
225 set_color(1);
226 clr_to_eol();
227 }
228 my $starts = starts_of($number);
229 if ( defined($opt_w) ) {
230 printf " ", if ( ( $number % 2 ) != 0 );
231 $length = ( $length - ( ($number) % 2 ) ) / 2;
232 }
233 my $string = substr( $test_string, $starts );
234 while ( length($string) < $length ) {
235 $string = $string . $test_string;
236 }
237 $string = substr( $string, 0, $length );
238 if ( defined($opt_w) ) {
239 $string = double_cells($string);
240 }
241 printf "%s", $string;
242
243 # now - within the line - modify it
244 move_to( ( 4 * $term_width ) / 5 );
245 insert_mode("XX");
246 move_to( ( 3 * $term_width ) / 5 );
247 delete_char();
248 move_to( ( 2 * $term_width ) / 5 );
249 insert_once('~');
250 move_to( ( 1 * $term_width ) / 5 );
251 write_chars('~');
252 move_to(0);
253 set_color(0);
254 }
255
256 sub main::HELP_MESSAGE() {
257 printf STDERR <<EOF
258 Usage: $0 [options]
259
260 Options:
261
262 -c use color
263 -n write line-numbers
264 -r repeat indefinitely
265 -w write wide-characters
266 EOF
267 ;
268 exit;
269 }
270
271 &getopts('cnrw') || die();
272
273 $term_height = screen_height();
274 $term_width = screen_width();
275
276 $test_string =
277 "0123456789 abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ";
278
279 binmode( STDOUT, ":utf8" );
280 clear_screen();
281 if ( defined($opt_r) ) {
282 for ( $lineno = 0 ; ; ++$lineno ) {
283 testit($lineno);
284 }
285 }
286 else {
287 for ( $lineno = 0 ; $lineno < $term_height * 2 ; ++$lineno ) {
288 testit($lineno);
289 }
290 }
291 lower_left();
292 clr_to_eol();
293
294 exit;