"Fossies" - the Fresh Open Source Software Archive

Member "xterm-379/vttests/blink.pl" (13 Jul 2007, 4160 Bytes) of package /linux/misc/xterm-379.tgz:

    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.
   36 use strict;
   37 
   38 use Getopt::Std;
   39 
   40 our ($opt_n, $opt_r, $opt_w);
   41 our ($lineno, $test_string, $term_width);
   42 
   43 # returns a string of two-column characters given an ASCII alpha/numeric string
   44 sub 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
   55 sub 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.
   68 sub 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
   81 sub 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 
  107 sub main::HELP_MESSAGE() {
  108     printf STDERR <<EOF
  109 Usage: $0 [options]
  110 
  111 Options:
  112 
  113 -n   write line-numbers
  114 -r   repeat indefinitely
  115 -w   write wide-characters
  116 EOF
  117 ;
  118     exit;
  119 }
  120 
  121 &getopts('nrw') || die();
  122 
  123 $term_width=`tput cols`;
  124 
  125 $test_string="0123456789 abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ";
  126 
  127 binmode(STDOUT, ":utf8");
  128 if ( 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 
  138 exit;