1#!/usr/bin/env perl 2# $XTermId: blink.pl,v 1.2 2007/07/13 00:28:38 tom Exp $ 3# ----------------------------------------------------------------------------- 4# this file is part of xterm 5# 6# Copyright 2007 by Thomas E. Dickey 7# 8# All Rights Reserved 9# 10# Permission is hereby granted, free of charge, to any person obtaining a 11# copy of this software and associated documentation files (the 12# "Software"), to deal in the Software without restriction, including 13# without limitation the rights to use, copy, modify, merge, publish, 14# distribute, sublicense, and/or sell copies of the Software, and to 15# permit persons to whom the Software is furnished to do so, subject to 16# the following conditions: 17# 18# The above copyright notice and this permission notice shall be included 19# in all copies or substantial portions of the Software. 20# 21# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS 22# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 23# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 24# IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY 25# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 26# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 27# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 28# 29# Except as contained in this notice, the name(s) of the above copyright 30# holders shall not be used in advertising or otherwise to promote the 31# sale, use or other dealings in this Software without prior written 32# authorization. 33# ----------------------------------------------------------------------------- 34# Write a test pattern which includes some blinking text in scattered 35# locations, to test scrollback of blinking text. 36use strict; 37 38use Getopt::Std; 39 40our ($opt_n, $opt_r, $opt_w); 41our ($lineno, $test_string, $term_width); 42 43# returns a string of two-column characters given an ASCII alpha/numeric string 44sub double_cells($) { 45 my $value = $_[0]; 46 $value =~ s/ / /g; 47 pack("U*", 48 map { ($_ <= 32 || $_ > 127) # if non-ASCII character... 49 ? 32 # ...just show a blank 50 : (0xff00 + ($_ - 32)) # map to "Fullwidth Form" 51 } unpack("C*", $value)); # unpack unsigned-char characters 52} 53 54# vary the starting point of each line, to make a more interesting pattern 55sub starts_of($) { 56 my $value = $_[0]; 57 if (defined($opt_w)) { 58 # 0,1,1,2,2,3,3,... 59 $value = (($value + 1) / 2) % length($test_string); 60 } else { 61 $value %= length($test_string); 62 } 63 return $value; 64} 65 66# vary the length of each line from $term_width - 5 to $term_width + 5, then 67# double it, and then repeat. That's 22/cycle. 68sub length_of($) { 69 my $value = $_[0]; 70 my $cycle = $value % 22; 71 if ( $cycle < 11 ) { 72 $value = $term_width; 73 } else { 74 $value = $term_width * 2; 75 $cycle /= 2; 76 } 77 return $value + $cycle - 5; 78} 79 80# write the text for the given line-number 81sub testit($) { 82 my $number = $_[0]; 83 my $length = length_of($number); 84 if ( defined($opt_n) ) { 85 printf "%5d ", $number % 99999; 86 $length -= 6; 87 } 88 # if we're printing double-column characters, we have half as much 89 # space effectively - but don't forget the remainder, so we can push 90 # the characters by single-columns. 91 my $starts = starts_of($number); 92 if ( defined($opt_w) ) { 93 printf " ", if ( ($number % 2 ) != 0); 94 $length = ($length + (($number + 1) % 2)) / 2; 95 } 96 my $string = substr($test_string, $starts); 97 while ( length($string) < $length ) { 98 $string = $string . $test_string; 99 } 100 $string = substr($string, 0, $length); 101 if ( defined($opt_w) ) { 102 $string = double_cells($string); 103 } 104 printf "%s\n", $string; 105} 106 107sub main::HELP_MESSAGE() { 108 printf STDERR <<EOF 109Usage: $0 [options] 110 111Options: 112 113-n write line-numbers 114-r repeat indefinitely 115-w write wide-characters 116EOF 117; 118 exit; 119} 120 121&getopts('nrw') || die(); 122 123$term_width=`tput cols`; 124 125$test_string="0123456789 abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"; 126 127binmode(STDOUT, ":utf8"); 128if ( defined($opt_r) ) { 129 for ($lineno = 0; ; ++$lineno) { 130 testit($lineno); 131 } 132} else { 133 for ($lineno = 0; $lineno < 24; ++$lineno) { 134 testit($lineno); 135 } 136} 137 138exit; 139