halves.pl revision a5ae21e4
1a5ae21e4Smrg#!/usr/bin/env perl
2a5ae21e4Smrg# $XTermId: halves.pl,v 1.6 2007/07/18 01:24:37 tom Exp $
3a5ae21e4Smrg# -----------------------------------------------------------------------------
4a5ae21e4Smrg# this file is part of xterm
5a5ae21e4Smrg#
6a5ae21e4Smrg# Copyright 2007 by Thomas E. Dickey
7a5ae21e4Smrg#
8a5ae21e4Smrg#                         All Rights Reserved
9a5ae21e4Smrg#
10a5ae21e4Smrg# Permission is hereby granted, free of charge, to any person obtaining a
11a5ae21e4Smrg# copy of this software and associated documentation files (the
12a5ae21e4Smrg# "Software"), to deal in the Software without restriction, including
13a5ae21e4Smrg# without limitation the rights to use, copy, modify, merge, publish,
14a5ae21e4Smrg# distribute, sublicense, and/or sell copies of the Software, and to
15a5ae21e4Smrg# permit persons to whom the Software is furnished to do so, subject to
16a5ae21e4Smrg# the following conditions:
17a5ae21e4Smrg#
18a5ae21e4Smrg# The above copyright notice and this permission notice shall be included
19a5ae21e4Smrg# in all copies or substantial portions of the Software.
20a5ae21e4Smrg#
21a5ae21e4Smrg# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
22a5ae21e4Smrg# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
23a5ae21e4Smrg# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
24a5ae21e4Smrg# IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
25a5ae21e4Smrg# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
26a5ae21e4Smrg# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
27a5ae21e4Smrg# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
28a5ae21e4Smrg#
29a5ae21e4Smrg# Except as contained in this notice, the name(s) of the above copyright
30a5ae21e4Smrg# holders shall not be used in advertising or otherwise to promote the
31a5ae21e4Smrg# sale, use or other dealings in this Software without prior written
32a5ae21e4Smrg# authorization.
33a5ae21e4Smrg# -----------------------------------------------------------------------------
34a5ae21e4Smrg# Draw a grid of characters (optionally double-width) and modify it using
35a5ae21e4Smrg# overstrike, insert- and delete-characters to see if the double-width
36a5ae21e4Smrg# characters are completely cleared when "partly" modified.
37a5ae21e4Smrguse strict;
38a5ae21e4Smrg
39a5ae21e4Smrguse Getopt::Std;
40a5ae21e4Smrg
41a5ae21e4Smrgour ($opt_c, $opt_n, $opt_r, $opt_w);
42a5ae21e4Smrgour ($lineno, $test_string, $term_width);
43a5ae21e4Smrg
44a5ae21e4Smrg# returns the number of columns in the screen
45a5ae21e4Smrgsub screen_width() {
46a5ae21e4Smrg	my $data = `resize -u |fgrep COLUMNS=`;
47a5ae21e4Smrg	$data =~ s/COLUMNS=//;
48a5ae21e4Smrg	$data =~ s/;//;
49a5ae21e4Smrg	return $data
50a5ae21e4Smrg}
51a5ae21e4Smrg
52a5ae21e4Smrgsub set_color($) {
53a5ae21e4Smrg	my $code = $_[0];
54a5ae21e4Smrg	if (defined($opt_c)) {
55a5ae21e4Smrg		if ($code == 3) {
56a5ae21e4Smrg			printf "\x1b[1;33;42m";	# yellow-on-green
57a5ae21e4Smrg		} elsif ($code == 2) {
58a5ae21e4Smrg			printf "\x1b[0;31;45m";	# red-on-magenta
59a5ae21e4Smrg		} elsif ($code == 1) {
60a5ae21e4Smrg			printf "\x1b[0;36;44m";	# cyan-on-blue
61a5ae21e4Smrg		} else {
62a5ae21e4Smrg			printf "\x1b[0;39;49m";
63a5ae21e4Smrg		}
64a5ae21e4Smrg	}
65a5ae21e4Smrg}
66a5ae21e4Smrg
67a5ae21e4Smrg# returns a string of two-column characters given an ASCII alpha/numeric string
68a5ae21e4Smrgsub double_cells($) {
69a5ae21e4Smrg	my $value = $_[0];
70a5ae21e4Smrg	$value =~ s/ /  /g;
71a5ae21e4Smrg	pack("U*",
72a5ae21e4Smrg	map { ($_ <= 32 || $_ > 127)      # if non-ASCII character...
73a5ae21e4Smrg	       ? 32                       # ...just show a blank
74a5ae21e4Smrg	       : (0xff00 + ($_ - 32))     # map to "Fullwidth Form"
75a5ae21e4Smrg	} unpack("C*", $value));          # unpack unsigned-char characters
76a5ae21e4Smrg}
77a5ae21e4Smrg
78a5ae21e4Smrgsub move_to($) {
79a5ae21e4Smrg	printf "\x1b[%dG", $_[0] + 1;
80a5ae21e4Smrg}
81a5ae21e4Smrg
82a5ae21e4Smrgsub delete_char() {
83a5ae21e4Smrg	set_color(2);
84a5ae21e4Smrg	printf "\x1b[%dP", 1;
85a5ae21e4Smrg	set_color(1);
86a5ae21e4Smrg}
87a5ae21e4Smrg
88a5ae21e4Smrgsub insert_once($) {
89a5ae21e4Smrg	set_color(2);
90a5ae21e4Smrg	printf "\x1b[%d@%s", length($_[0]);
91a5ae21e4Smrg	write_chars($_[0]);
92a5ae21e4Smrg}
93a5ae21e4Smrg
94a5ae21e4Smrgsub insert_mode($) {
95a5ae21e4Smrg	set_color(2);
96a5ae21e4Smrg	printf "\x1b[%dP", length($_[0]);
97a5ae21e4Smrg	printf "\x1b[4h";
98a5ae21e4Smrg	write_chars($_[0]);
99a5ae21e4Smrg	printf "\x1b[4l";
100a5ae21e4Smrg}
101a5ae21e4Smrg
102a5ae21e4Smrgsub write_chars($) {
103a5ae21e4Smrg	set_color(3);
104a5ae21e4Smrg	printf "%s", $_[0];
105a5ae21e4Smrg	set_color(1);
106a5ae21e4Smrg}
107a5ae21e4Smrg
108a5ae21e4Smrg# vary the starting point of each line, to make a more interesting pattern
109a5ae21e4Smrgsub starts_of($) {
110a5ae21e4Smrg	my $value = $_[0];
111a5ae21e4Smrg	if (defined($opt_w)) {
112a5ae21e4Smrg		# 0,1,1,2,2,3,3,...
113a5ae21e4Smrg		$value = (($value + 1) / 2) % length($test_string);
114a5ae21e4Smrg	} else {
115a5ae21e4Smrg		$value %= length($test_string);
116a5ae21e4Smrg	}
117a5ae21e4Smrg	return $value;
118a5ae21e4Smrg}
119a5ae21e4Smrg
120a5ae21e4Smrg# write the text for the given line-number
121a5ae21e4Smrgsub testit($) {
122a5ae21e4Smrg	my $number = $_[0];
123a5ae21e4Smrg	my $length = $term_width;
124a5ae21e4Smrg	if ( defined($opt_n) ) {
125a5ae21e4Smrg		printf "%5d ", $number % 99999;
126a5ae21e4Smrg		$length -= 6;
127a5ae21e4Smrg	}
128a5ae21e4Smrg	# if we're printing double-column characters, we have half as much
129a5ae21e4Smrg	# space effectively - but don't forget the remainder, so we can push
130a5ae21e4Smrg	# the characters by single-columns.
131a5ae21e4Smrg	if (defined($opt_c)) {
132a5ae21e4Smrg		set_color(1);
133a5ae21e4Smrg		printf "\x1b[K";
134a5ae21e4Smrg	}
135a5ae21e4Smrg	my $starts = starts_of($number);
136a5ae21e4Smrg	if ( defined($opt_w) ) {
137a5ae21e4Smrg		printf " ", if ( ($number % 2 ) != 0);
138a5ae21e4Smrg		$length = ($length - (($number) % 2)) / 2;
139a5ae21e4Smrg	}
140a5ae21e4Smrg	my $string = substr($test_string, $starts);
141a5ae21e4Smrg	while ( length($string) < $length ) {
142a5ae21e4Smrg		$string = $string . $test_string;
143a5ae21e4Smrg	}
144a5ae21e4Smrg	$string = substr($string, 0, $length);
145a5ae21e4Smrg	if ( defined($opt_w) ) {
146a5ae21e4Smrg		$string = double_cells($string);
147a5ae21e4Smrg	}
148a5ae21e4Smrg	printf "%s", $string;
149a5ae21e4Smrg	# now - within the line - modify it
150a5ae21e4Smrg	move_to((4 * $term_width) / 5);
151a5ae21e4Smrg	insert_mode("XX");
152a5ae21e4Smrg	move_to((3 * $term_width) / 5);
153a5ae21e4Smrg	delete_char();
154a5ae21e4Smrg	move_to((2 * $term_width) / 5);
155a5ae21e4Smrg	insert_once('~');
156a5ae21e4Smrg	move_to((1 * $term_width) / 5);
157a5ae21e4Smrg	write_chars('~');
158a5ae21e4Smrg	move_to(0);
159a5ae21e4Smrg	set_color(0);
160a5ae21e4Smrg	printf "\n", $string;
161a5ae21e4Smrg}
162a5ae21e4Smrg
163a5ae21e4Smrgsub main::HELP_MESSAGE() {
164a5ae21e4Smrg	printf STDERR <<EOF
165a5ae21e4SmrgUsage: $0 [options]
166a5ae21e4Smrg
167a5ae21e4SmrgOptions:
168a5ae21e4Smrg
169a5ae21e4Smrg-c   use color
170a5ae21e4Smrg-n   write line-numbers
171a5ae21e4Smrg-r   repeat indefinitely
172a5ae21e4Smrg-w   write wide-characters
173a5ae21e4SmrgEOF
174a5ae21e4Smrg;
175a5ae21e4Smrg	exit;
176a5ae21e4Smrg}
177a5ae21e4Smrg
178a5ae21e4Smrg&getopts('cnrw') || die();
179a5ae21e4Smrg
180a5ae21e4Smrg$term_width = screen_width();
181a5ae21e4Smrg
182a5ae21e4Smrg$test_string="0123456789 abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ";
183a5ae21e4Smrg
184a5ae21e4Smrgbinmode(STDOUT, ":utf8");
185a5ae21e4Smrgif ( defined($opt_r) ) {
186a5ae21e4Smrg	for ($lineno = 0; ; ++$lineno) {
187a5ae21e4Smrg		testit($lineno);
188a5ae21e4Smrg	}
189a5ae21e4Smrg} else {
190a5ae21e4Smrg	for ($lineno = 0; $lineno < 24; ++$lineno) {
191a5ae21e4Smrg		testit($lineno);
192a5ae21e4Smrg	}
193a5ae21e4Smrg}
194a5ae21e4Smrg
195a5ae21e4Smrgexit;
196