erase.pl revision a5ae21e4 
1#!/usr/bin/env perl
2# $XTermId: erase.pl,v 1.4 2007/07/18 21:15:08 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# Generate a test-pattern, erasing parts of the text on each line.
33# The test-pattern optionally includes double-width or other characters
34# encoded in UTF-8.
35use strict;
36
37use Getopt::Std;
38
39our ($opt_c, $opt_n, $opt_r, $opt_w);
40our ($lineno, $test_string, $term_width, $term_height);
41
42sub set_color($) {
43	my $code = $_[0];
44	if (defined($opt_c)) {
45		if ($code == 3) {
46			printf "\x1b[1;33;42m";	# yellow-on-green
47		} elsif ($code == 2) {
48			printf "\x1b[0;31;45m";	# red-on-magenta
49		} elsif ($code == 1) {
50			printf "\x1b[0;36;44m";	# cyan-on-blue
51		} else {
52			printf "\x1b[0;39;49m";
53		}
54	}
55}
56
57# returns a string of two-column characters given an ASCII alpha/numeric string
58sub double_cells($) {
59	my $value = $_[0];
60	$value =~ s/ /  /g;
61	pack("U*",
62	map { ($_ <= 32 || $_ > 127)      # if non-ASCII character...
63	       ? 32                       # ...just show a blank
64	       : (0xff00 + ($_ - 32))     # map to "Fullwidth Form"
65	} unpack("C*", $value));          # unpack unsigned-char characters
66}
67
68sub erase_left() {
69	set_color(2);
70	printf "\x1b[1K";
71	set_color(1);
72}
73
74sub erase_right() {
75	set_color(2);
76	printf "\x1b[0K";
77	set_color(1);
78}
79
80sub erase_middle($) {
81	set_color(3);
82	printf "\x1b[%dX", $_[0];
83	set_color(1);
84}
85
86sub move_to($) {
87	printf "\x1b[%dG", $_[0] + 1;
88}
89
90# write the text for the given line-number
91sub testit($) {
92	my $number = $_[0];
93	my $length = $term_width;
94	my $actual;
95	my $margin = 0;
96	if ( defined($opt_n) ) {
97		$margin = 6;
98		move_to($margin);
99		$length -= $margin;
100	}
101	$actual = $length;
102	if (defined($opt_c)) {
103		set_color(1);
104		erase_right();
105	}
106	if ( defined($opt_w) ) {
107		$length /= 2;
108	}
109	my $string = $test_string;
110	while ( length($string) < $length ) {
111		$string = $string . $test_string;
112	}
113	$string = substr($string, 0, $length);
114	if ( defined($opt_w) ) {
115		$string = double_cells($string);
116	}
117	printf "%s", $string;
118
119	move_to($margin + ($number % ($actual / 3)));
120	erase_left();
121
122	move_to($margin + ((2 * $actual) / 3) + ($number % ($actual / 3)));
123	erase_right();
124
125	move_to($margin + ((1 * $actual) / 3) + ($number % ($actual / 3)));
126	erase_middle($actual / 10);
127
128	set_color(0);
129	if ( defined($opt_n) ) {
130		move_to(0);
131		printf "%5d ", $number % 99999;
132	}
133	printf "\n";
134}
135
136sub main::HELP_MESSAGE() {
137	printf STDERR <<EOF
138Usage: $0 [options]
139
140Options:
141
142-c   use color
143-n   write line-numbers
144-r   repeat indefinitely
145-w   write wide-characters
146EOF
147;
148	exit;
149}
150
151&getopts('cnrw') || die();
152
153$term_width=`tput cols`;
154$term_height=`tput lines`;
155
156$test_string="0123456789 ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz";
157
158binmode(STDOUT, ":utf8");
159if ( defined($opt_r) ) {
160	for ($lineno = 0; ; ++$lineno) {
161		testit($lineno);
162	}
163} else {
164	for ($lineno = 0; $lineno < $term_height - 1; ++$lineno) {
165		testit($lineno);
166	}
167}
168
169exit;
170