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