"Fossies" - the Fresh Open Source Software Archive

Member "xterm-379/vttests/mouse-codes" (13 Dec 2020, 5264 Bytes) of package /linux/misc/xterm-379.tgz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/bin/env perl
    2 # $XTermId: mouse-codes,v 1.7 2020/12/13 15:07:02 tom Exp $
    3 # -----------------------------------------------------------------------------
    4 # this file is part of xterm
    5 #
    6 # Copyright 2018-2019,2020 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 # Imitate xterm's BtnCode() function, to enumerate the possible inputs (button,
   35 # event state) versus output (xterm mouse-code).
   36 use strict;
   37 use warnings;
   38 
   39 use Getopt::Std;
   40 
   41 our ( $opt_b, $opt_i, $opt_x );
   42 
   43 # Typically,
   44 # - Buttons 1, 2, and 3 are left-to-right assignments on a 3-button mouse.
   45 # - Buttons 4 and 5 are (by convention) assigned to a wheel mouse's
   46 #   up/down events.
   47 # - Buttons 6 and 7 may happen to work, e.g., as left/right events from a
   48 #   tiltable wheel mouse.  There is no explicit support for these (there
   49 #   are no related symbols in Xt), so it is not possible to use them in the
   50 #   translations resource.
   51 our $maxbutton = 7;
   52 
   53 # xterm uses code 3 internally for release-events.
   54 sub ButtonName($) {
   55     my $code   = shift;
   56     my $result = "";
   57     if ( $code < 0 ) {
   58         $result = "release";
   59     }
   60     else {
   61         $result = sprintf "Button%d", ( $code > 3 ) ? $code : ( $code + 1 );
   62     }
   63     return $result;
   64 }
   65 
   66 # Combine the modifier state as bits:
   67 #  shift key   -> 1
   68 #  meta key    -> 2 (Mod1 came from X11R1, but was adapted from X10)
   69 #  control key -> 4
   70 our $maxstates = 7;
   71 
   72 sub KeyState($) {
   73     my $mask   = shift;
   74     my $result = "";
   75     $result .= " + shift"   if ( ( $mask & 1 ) != 0 );
   76     $result .= " + meta"    if ( ( $mask & 2 ) != 0 );
   77     $result .= " + control" if ( ( $mask & 4 ) != 0 );
   78     return $result;
   79 }
   80 
   81 sub Motion($) {
   82     my $code   = shift;
   83     my $result = "";
   84     $result = " + motion" if ( $code != 0 );
   85     return $result;
   86 }
   87 
   88 sub report() {
   89     my $button;
   90     my $states;
   91     my $motion;
   92     my %encoded;
   93     my %reports;
   94     for $states ( 0 .. $maxstates ) {
   95         for $motion ( 0 .. 1 ) {
   96             for $button ( -1 .. $maxbutton ) {
   97                 next if ( $button == 3 );
   98                 my $result = ( 32 + ( $states << 2 ) );
   99                 $result += 32 if ( $motion != 0 );
  100                 if ( $button < 0 ) {
  101                     $result += 3;
  102                 }
  103                 else {
  104                     $result += $button & 3;
  105                     if ( $button & 4 ) {
  106                         $result += 64;
  107                     }
  108                     if ( $button & 8 ) {
  109                         $result += 128;
  110                     }
  111                 }
  112                 my $code   = sprintf "%3d",    $result;
  113                 my $report = sprintf "%s%s%s", &ButtonName($button),
  114                   &KeyState($states), &Motion($motion);
  115                 if ( defined $encoded{$code} ) {
  116                     printf "OOPS %s ->%s versus %s\n", $code, $report,
  117                       $encoded{$code};
  118                 }
  119                 elsif ( $result > 255 and not defined $opt_x ) {
  120                     printf "OOPS %s ->%s\n", $code, $report;
  121                 }
  122                 $encoded{$code}   = $report;
  123                 $reports{$report} = $result;
  124             }
  125         }
  126     }
  127     if ($opt_i) {
  128         foreach my $report ( sort keys %reports ) {
  129             printf "%s = %s\n", $report, $reports{$report};
  130         }
  131     }
  132     else {
  133         foreach my $code ( sort keys %encoded ) {
  134             printf "%s = %s\n", $code, $encoded{$code};
  135         }
  136     }
  137 }
  138 
  139 sub main::HELP_MESSAGE() {
  140     printf STDERR <<EOF
  141 Usage: $0 [options]
  142 
  143 Options:
  144     -b NUM  set the number of buttons (default: 7)
  145     -i  invert the report to show code for each combination
  146     -x  eliminate 1-byte limit for codes
  147 EOF
  148       ;
  149     exit 1;
  150 }
  151 $Getopt::Std::STANDARD_HELP_VERSION = 1;
  152 &getopts('b:ix') || &main::HELP_MESSAGE;
  153 $maxbutton = $opt_b if ( defined $opt_b );
  154 &main::HELP_MESSAGE if ( $maxbutton !~ /^\d+$/ );
  155 $#ARGV < 0 || &main::HELP_MESSAGE;
  156 
  157 &report;
  158 
  159 1;