"Fossies" - the Fresh Open Source Software Archive 
Member "xterm-379/vttests/wrap.pl" (13 Jul 2007, 5119 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 "wrap.pl" see the
Fossies "Dox" file reference documentation.
1 #!/usr/bin/env perl
2 # $XTermId: wrap.pl,v 1.12 2007/07/13 00:15:28 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 # Generates a series of wrapping lines, according to the terminal width.
33 # The wrapping text optionally includes double-width or other characters
34 # encoded in UTF-8.
35 use strict;
36
37 use Getopt::Std;
38
39 our ($opt_i, $opt_n, $opt_r, $opt_w);
40 our ($lineno, $test_string, $term_width);
41
42 # Return a string of two-column characters given an ASCII alpha/numeric string
43 sub double_cells($) {
44 my $value = $_[0];
45 $value =~ s/ / /g;
46 pack("U*",
47 map { ($_ <= 32 || $_ > 127) # if non-ASCII character...
48 ? 32 # ...just show a blank
49 : (0xff00 + ($_ - 32)) # map to "Fullwidth Form"
50 } unpack("C*", $value)); # unpack unsigned-char characters
51 }
52
53 # Insert a character using escape sequences to push the existing text to the
54 # right, write the actual character and then move left one column so succeeding
55 # calls will do the same. This will not cause the pushed-text to wrap, but
56 # will exercise the right-margin logic in other ways.
57 #
58 # Since this script does not modify the autowrap mode, you can reset that
59 # outside the script and compare the default (unwrapped) versus the "-i"
60 # option.
61 sub insert_char($$) {
62 my $value = $_[0];
63 my $final = $_[1];
64 my $cells = defined($opt_w) ? 2 : 1;
65 printf "\x1b[%d@", $cells;
66 printf "%s", defined($opt_w) ? double_cells($value) : $value;
67 if ( ! $final ) {
68 printf "\x1b[%dD", $cells;
69 }
70 }
71
72 # vary the starting point of each line, to make a more interesting pattern
73 sub starts_of($) {
74 my $value = $_[0];
75 if (defined($opt_w)) {
76 # 0,1,1,2,2,3,3,...
77 $value = (($value + 1) / 2) % length($test_string);
78 } else {
79 $value %= length($test_string);
80 }
81 return $value;
82 }
83
84 # Vary the length of each line from $term_width - 5 to $term_width + 5, then
85 # double it, and then repeat. That's 22/cycle.
86 sub length_of($) {
87 my $value = $_[0];
88 my $cycle = $value % 22;
89 if ( $cycle < 11 ) {
90 $value = $term_width;
91 } else {
92 $value = $term_width * 2;
93 $cycle /= 2;
94 }
95 return $value + $cycle - 5;
96 }
97
98 # Write the text for the given line-number.
99 sub testit($) {
100 my $number = $_[0];
101 my $length = length_of($number);
102 if ( defined($opt_n) ) {
103 printf "%5d ", $number % 99999;
104 $length -= 6;
105 }
106 # If we're printing double-column characters, we have half as much
107 # space effectively - but don't forget the remainder, so we can push
108 # the characters by single-columns.
109 my $starts = starts_of($number);
110 if ( defined($opt_w) ) {
111 printf " ", if ( ($number % 2 ) != 0);
112 $length = ($length + (($number + 1) % 2)) / 2;
113 }
114 my $string = substr($test_string, $starts);
115 while ( length($string) < $length ) {
116 $string = $string . $test_string;
117 }
118 $string = substr($string, 0, $length);
119 if ( defined($opt_i) ) {
120 my ($n, $c);
121 for ($n = length($string) - 1; $n >= 0; $n--) {
122 insert_char(substr($string, $n, 1), $n == 0);
123 }
124 printf "\n";
125 } else {
126 if ( defined($opt_w) ) {
127 $string = double_cells($string);
128 }
129 printf "%s\n", $string;
130 }
131 }
132
133 sub main::HELP_MESSAGE() {
134 printf STDERR <<EOF
135 Usage: $0 [options]
136
137 Options:
138
139 -i construct lines by inserting characters on the left
140 -n write line-numbers
141 -r repeat indefinitely
142 -w write wide-character test-string
143 EOF
144 ;
145 exit;
146 }
147
148 &getopts('inrw') || die();
149
150 $term_width=`tput cols`;
151
152 $test_string="0123456789 abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ";
153
154 binmode(STDOUT, ":utf8");
155 if ( defined($opt_r) ) {
156 for ($lineno = 0; ; ++$lineno) {
157 testit($lineno);
158 }
159 } else {
160 for ($lineno = 0; $lineno < 24; ++$lineno) {
161 testit($lineno);
162 }
163 }
164
165 exit;