"Fossies" - the Fresh Open Source Software Archive

Member "xterm-379/vttests/iso2022.pl" (13 Feb 2021, 3064 Bytes) of package /linux/misc/xterm-379.tgz:

    1 #!/usr/bin/env perl
    2 # $XTermId: iso2022.pl,v 1.5 2021/02/13 01:24:32 tom Exp $
    3 # -----------------------------------------------------------------------------
    4 # Copyright 2021 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 # show ISO-2022 characters, by default GL and GR, optionally G1/G2/G3
   33 
   34 use strict;
   35 use warnings;
   36 
   37 use Getopt::Std;
   38 
   39 $| = 1;
   40 
   41 our ( $opt_k, $opt_n, $opt_q, $opt_s );
   42 
   43 sub doit() {
   44     my $GL = "";
   45     printf "-- vile: fk=8bit\n";
   46     my $lo = 0;
   47     if ($opt_q) {
   48         $GL =
   49             "`1234567890-=\n"
   50           . "qwertyuiop[]\\\n"
   51           . "asdfghjkl;'\n"
   52           . "zxcvbnm,./\n"
   53           . "~!@#$%^&*()_+\n"
   54           . "QWERTYUIOP{}|\n"
   55           . "ASDFGHJKL:\"\n"
   56           . "ZXCVBNM<>?";
   57     }
   58     else {
   59         $lo = $opt_k ? 0 : 32;
   60         for my $n ( $lo .. 127 ) {
   61             $GL .= chr($n);
   62             $GL .= "\n" if ( ( ( $n - 31 ) % 16 ) == 0 );
   63         }
   64     }
   65     my $GR = "";
   66     for my $n ( 0 .. ( length($GL) - 1 ) ) {
   67         my $c = substr( $GL, $n, 1 );
   68         if ( ord($c) == 10 and ( not $opt_k or $n != 10 ) ) {
   69             $GR .= $c;
   70         }
   71         else {
   72             $GR .= chr( ord($c) + 128 );
   73         }
   74     }
   75     if ($opt_s) {
   76         $GL =~ s/([^\n])/ $1/g;
   77         $GR =~ s/([^\n])/ $1/g;
   78     }
   79     printf "GL:\n%s\n", $GL;
   80     printf "GR:\n%s\n", $GR;
   81 }
   82 
   83 sub main::HELP_MESSAGE() {
   84     printf STDERR <<EOF
   85 Usage: $0 [options]
   86 
   87 Options:
   88     -k  assume 128-159 are printable.
   89     -n  print hex value before each character
   90     -q  use QWERTY
   91     -s  space between characters
   92 EOF
   93       ;
   94     exit 1;
   95 }
   96 $Getopt::Std::STANDARD_HELP_VERSION = 1;
   97 &getopts('knqs') || main::HELP_MESSAGE;
   98 
   99 &doit;
  100 
  101 1;