"Fossies" - the Fresh Open Source Software Archive

Member "xterm-379/vttests/decsed.pl" (22 Feb 2015, 4962 Bytes) of package /linux/misc/xterm-379.tgz:

    1 #!/usr/bin/env perl
    2 # $XTermId: decsed.pl,v 1.6 2015/02/22 01:37:20 tom Exp $
    3 # -----------------------------------------------------------------------------
    4 # this file is part of xterm
    5 #
    6 # Copyright 2015 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 # Exercise DECSED (erase display) with or without DECSCA (protect against
   35 # DECSED).
   36 use strict;
   37 
   38 use Getopt::Std;
   39 
   40 our ( $opt_c,  $opt_n,       $opt_p,     $opt_w );
   41 our ( $lineno, $test_string, $term_wide, $term_high );
   42 
   43 sub move($$) {
   44     my $y = shift;
   45     my $x = shift;
   46     printf "\x1b[%d;%dH", $y, $x;
   47 }
   48 
   49 sub protect($) {
   50     my $code = shift;
   51     printf "\x1b[%d\"q", $code;
   52 }
   53 
   54 sub set_color($) {
   55     my $code = shift;
   56     if ( $code == 1 ) {
   57         printf "\x1b[0;36;44m";    # cyan-on-blue
   58     }
   59     else {
   60         printf "\x1b[0;39;49m";
   61     }
   62 }
   63 
   64 # returns a string of two-column characters given an ASCII alpha/numeric string
   65 sub double_cells($) {
   66     my $value = $_[0];
   67     $value =~ s/ /  /g;
   68     pack(
   69         "U*",
   70         map {
   71             ( $_ <= 32 || $_ > 127 )    # if non-ASCII character...
   72               ? 32                      # ...just show a blank
   73               : ( 0xff00 + ( $_ - 32 ) )    # map to "Fullwidth Form"
   74           } unpack( "C*", $value )
   75     );                                      # unpack unsigned-char characters
   76 }
   77 
   78 # write the text for the given line-number
   79 sub fill_line($$) {
   80     my $number = shift;
   81     my $offset = shift;
   82     my $length = $opt_w ? ( $term_wide / 2 ) : $term_wide;
   83     my $actual;
   84     my $margin = 0;
   85     $actual = $length;
   86     my $string = $test_string;
   87     while ( ( $opt_w ? ( 2 * length($string) ) : length($string) ) <
   88         ( $offset + $length ) )
   89     {
   90         $string = $string . $test_string;
   91     }
   92     $string = substr( $string, $offset, $length );
   93     $string = double_cells($string) if ($opt_w);
   94     printf "%s", $string;
   95 
   96     printf "\n";
   97     return ++$offset;
   98 }
   99 
  100 sub main::HELP_MESSAGE() {
  101     printf STDERR <<EOF
  102 Usage: $0 [options] DECSED [y [x]]
  103 
  104 The test
  105     fills the screen (-n for normal, -w for wide characters, default DECALN)
  106     then positions to the given y,x (default is middle of screen),
  107     writes a '*' at the cursor position
  108     moves back to given y,x again
  109     erases with the DECSED value (0=below, 1=above, 2=all=default),
  110     moves the cursor up/down one line to avoid overwriting by prompt
  111 
  112 Options:
  113 
  114 -c   use color
  115 -n   write normal-characters rather than using DECALN
  116 -p   protect screen against erasure using DECSCA (DECALN is unprotected)
  117 -w   write wide-characters rather than using DECALN
  118 EOF
  119       ;
  120     exit;
  121 }
  122 
  123 &getopts('cnpw') || &main::HELP_MESSAGE;
  124 
  125 $term_wide = `tput cols`;
  126 $term_high = `tput lines`;
  127 
  128 $test_string =
  129   "0123456789 ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz";
  130 
  131 my $parm_DECSED = ( $#ARGV >= 0 ) ? $ARGV[0] : 2;
  132 my $parm_ycoord = ( $#ARGV >= 1 ) ? $ARGV[1] : $term_high / 2;
  133 my $parm_xcoord = ( $#ARGV >= 2 ) ? $ARGV[2] : $term_wide / 2;
  134 
  135 binmode( STDOUT, ":utf8" );
  136 &protect(1)   if ($opt_p);
  137 &set_color(1) if ($opt_c);
  138 if ( $opt_n or $opt_w ) {
  139     my $offset = 0;
  140     for ( $lineno = 0 ; $lineno < $term_high - 1 ; ++$lineno ) {
  141         $offset = &fill_line( $lineno, $offset );
  142     }
  143 }
  144 else {
  145     printf "\x1b#8";    # DECALN
  146 }
  147 &move( $parm_ycoord, $parm_xcoord );
  148 printf '*';
  149 &move( $parm_ycoord, $parm_xcoord );
  150 printf "\x1b[?%dJ", $parm_DECSED;
  151 if ( $parm_DECSED == 0 ) {
  152     &move( $parm_ycoord + 1, $parm_xcoord );
  153 }
  154 elsif ( $parm_DECSED == 1 ) {
  155     &move( $parm_ycoord - 1, $parm_xcoord );
  156 }
  157 &set_color(0) if ($opt_c);
  158 &protect(0)   if ($opt_p);
  159 
  160 exit;