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