"Fossies" - the Fresh Open Source Software Archive

Member "xterm-379/vttests/erase.pl" (18 Jul 2007, 4393 Bytes) of package /linux/misc/xterm-379.tgz:

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