Home | History | Annotate | Line # | Download | only in vttests
mouse-codes revision 1.1.1.1.2.2
      1  1.1.1.1.2.2  martin #!/usr/bin/env perl
      2  1.1.1.1.2.2  martin # $XTermId: mouse-codes,v 1.7 2020/12/13 15:07:02 tom Exp $
      3  1.1.1.1.2.2  martin # -----------------------------------------------------------------------------
      4  1.1.1.1.2.2  martin # this file is part of xterm
      5  1.1.1.1.2.2  martin #
      6  1.1.1.1.2.2  martin # Copyright 2018-2019,2020 by Thomas E. Dickey
      7  1.1.1.1.2.2  martin #
      8  1.1.1.1.2.2  martin #                         All Rights Reserved
      9  1.1.1.1.2.2  martin #
     10  1.1.1.1.2.2  martin # Permission is hereby granted, free of charge, to any person obtaining a
     11  1.1.1.1.2.2  martin # copy of this software and associated documentation files (the
     12  1.1.1.1.2.2  martin # "Software"), to deal in the Software without restriction, including
     13  1.1.1.1.2.2  martin # without limitation the rights to use, copy, modify, merge, publish,
     14  1.1.1.1.2.2  martin # distribute, sublicense, and/or sell copies of the Software, and to
     15  1.1.1.1.2.2  martin # permit persons to whom the Software is furnished to do so, subject to
     16  1.1.1.1.2.2  martin # the following conditions:
     17  1.1.1.1.2.2  martin #
     18  1.1.1.1.2.2  martin # The above copyright notice and this permission notice shall be included
     19  1.1.1.1.2.2  martin # in all copies or substantial portions of the Software.
     20  1.1.1.1.2.2  martin #
     21  1.1.1.1.2.2  martin # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
     22  1.1.1.1.2.2  martin # OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
     23  1.1.1.1.2.2  martin # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
     24  1.1.1.1.2.2  martin # IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
     25  1.1.1.1.2.2  martin # CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
     26  1.1.1.1.2.2  martin # TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
     27  1.1.1.1.2.2  martin # SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
     28  1.1.1.1.2.2  martin #
     29  1.1.1.1.2.2  martin # Except as contained in this notice, the name(s) of the above copyright
     30  1.1.1.1.2.2  martin # holders shall not be used in advertising or otherwise to promote the
     31  1.1.1.1.2.2  martin # sale, use or other dealings in this Software without prior written
     32  1.1.1.1.2.2  martin # authorization.
     33  1.1.1.1.2.2  martin # -----------------------------------------------------------------------------
     34  1.1.1.1.2.2  martin # Imitate xterm's BtnCode() function, to enumerate the possible inputs (button,
     35  1.1.1.1.2.2  martin # event state) versus output (xterm mouse-code).
     36  1.1.1.1.2.2  martin use strict;
     37  1.1.1.1.2.2  martin use warnings;
     38  1.1.1.1.2.2  martin 
     39  1.1.1.1.2.2  martin use Getopt::Std;
     40  1.1.1.1.2.2  martin 
     41  1.1.1.1.2.2  martin our ( $opt_b, $opt_i, $opt_x );
     42  1.1.1.1.2.2  martin 
     43  1.1.1.1.2.2  martin # Typically,
     44  1.1.1.1.2.2  martin # -	Buttons 1, 2, and 3 are left-to-right assignments on a 3-button mouse.
     45  1.1.1.1.2.2  martin # -	Buttons 4 and 5 are (by convention) assigned to a wheel mouse's
     46  1.1.1.1.2.2  martin #	up/down events.
     47  1.1.1.1.2.2  martin # -	Buttons 6 and 7 may happen to work, e.g., as left/right events from a
     48  1.1.1.1.2.2  martin #	tiltable wheel mouse.  There is no explicit support for these (there
     49  1.1.1.1.2.2  martin #	are no related symbols in Xt), so it is not possible to use them in the
     50  1.1.1.1.2.2  martin #	translations resource.
     51  1.1.1.1.2.2  martin our $maxbutton = 7;
     52  1.1.1.1.2.2  martin 
     53  1.1.1.1.2.2  martin # xterm uses code 3 internally for release-events.
     54  1.1.1.1.2.2  martin sub ButtonName($) {
     55  1.1.1.1.2.2  martin     my $code   = shift;
     56  1.1.1.1.2.2  martin     my $result = "";
     57  1.1.1.1.2.2  martin     if ( $code < 0 ) {
     58  1.1.1.1.2.2  martin         $result = "release";
     59  1.1.1.1.2.2  martin     }
     60  1.1.1.1.2.2  martin     else {
     61  1.1.1.1.2.2  martin         $result = sprintf "Button%d", ( $code > 3 ) ? $code : ( $code + 1 );
     62  1.1.1.1.2.2  martin     }
     63  1.1.1.1.2.2  martin     return $result;
     64  1.1.1.1.2.2  martin }
     65  1.1.1.1.2.2  martin 
     66  1.1.1.1.2.2  martin # Combine the modifier state as bits:
     67  1.1.1.1.2.2  martin #  shift key   -> 1
     68  1.1.1.1.2.2  martin #  meta key    -> 2 (Mod1 came from X11R1, but was adapted from X10)
     69  1.1.1.1.2.2  martin #  control key -> 4
     70  1.1.1.1.2.2  martin our $maxstates = 7;
     71  1.1.1.1.2.2  martin 
     72  1.1.1.1.2.2  martin sub KeyState($) {
     73  1.1.1.1.2.2  martin     my $mask   = shift;
     74  1.1.1.1.2.2  martin     my $result = "";
     75  1.1.1.1.2.2  martin     $result .= " + shift"   if ( ( $mask & 1 ) != 0 );
     76  1.1.1.1.2.2  martin     $result .= " + meta"    if ( ( $mask & 2 ) != 0 );
     77  1.1.1.1.2.2  martin     $result .= " + control" if ( ( $mask & 4 ) != 0 );
     78  1.1.1.1.2.2  martin     return $result;
     79  1.1.1.1.2.2  martin }
     80  1.1.1.1.2.2  martin 
     81  1.1.1.1.2.2  martin sub Motion($) {
     82  1.1.1.1.2.2  martin     my $code   = shift;
     83  1.1.1.1.2.2  martin     my $result = "";
     84  1.1.1.1.2.2  martin     $result = " + motion" if ( $code != 0 );
     85  1.1.1.1.2.2  martin     return $result;
     86  1.1.1.1.2.2  martin }
     87  1.1.1.1.2.2  martin 
     88  1.1.1.1.2.2  martin sub report() {
     89  1.1.1.1.2.2  martin     my $button;
     90  1.1.1.1.2.2  martin     my $states;
     91  1.1.1.1.2.2  martin     my $motion;
     92  1.1.1.1.2.2  martin     my %encoded;
     93  1.1.1.1.2.2  martin     my %reports;
     94  1.1.1.1.2.2  martin     for $states ( 0 .. $maxstates ) {
     95  1.1.1.1.2.2  martin         for $motion ( 0 .. 1 ) {
     96  1.1.1.1.2.2  martin             for $button ( -1 .. $maxbutton ) {
     97  1.1.1.1.2.2  martin                 next if ( $button == 3 );
     98  1.1.1.1.2.2  martin                 my $result = ( 32 + ( $states << 2 ) );
     99  1.1.1.1.2.2  martin                 $result += 32 if ( $motion != 0 );
    100  1.1.1.1.2.2  martin                 if ( $button < 0 ) {
    101  1.1.1.1.2.2  martin                     $result += 3;
    102  1.1.1.1.2.2  martin                 }
    103  1.1.1.1.2.2  martin                 else {
    104  1.1.1.1.2.2  martin                     $result += $button & 3;
    105  1.1.1.1.2.2  martin                     if ( $button & 4 ) {
    106  1.1.1.1.2.2  martin                         $result += 64;
    107  1.1.1.1.2.2  martin                     }
    108  1.1.1.1.2.2  martin                     if ( $button & 8 ) {
    109  1.1.1.1.2.2  martin                         $result += 128;
    110  1.1.1.1.2.2  martin                     }
    111  1.1.1.1.2.2  martin                 }
    112  1.1.1.1.2.2  martin                 my $code   = sprintf "%3d",    $result;
    113  1.1.1.1.2.2  martin                 my $report = sprintf "%s%s%s", &ButtonName($button),
    114  1.1.1.1.2.2  martin                   &KeyState($states), &Motion($motion);
    115  1.1.1.1.2.2  martin                 if ( defined $encoded{$code} ) {
    116  1.1.1.1.2.2  martin                     printf "OOPS %s ->%s versus %s\n", $code, $report,
    117  1.1.1.1.2.2  martin                       $encoded{$code};
    118  1.1.1.1.2.2  martin                 }
    119  1.1.1.1.2.2  martin                 elsif ( $result > 255 and not defined $opt_x ) {
    120  1.1.1.1.2.2  martin                     printf "OOPS %s ->%s\n", $code, $report;
    121  1.1.1.1.2.2  martin                 }
    122  1.1.1.1.2.2  martin                 $encoded{$code}   = $report;
    123  1.1.1.1.2.2  martin                 $reports{$report} = $result;
    124  1.1.1.1.2.2  martin             }
    125  1.1.1.1.2.2  martin         }
    126  1.1.1.1.2.2  martin     }
    127  1.1.1.1.2.2  martin     if ($opt_i) {
    128  1.1.1.1.2.2  martin         foreach my $report ( sort keys %reports ) {
    129  1.1.1.1.2.2  martin             printf "%s = %s\n", $report, $reports{$report};
    130  1.1.1.1.2.2  martin         }
    131  1.1.1.1.2.2  martin     }
    132  1.1.1.1.2.2  martin     else {
    133  1.1.1.1.2.2  martin         foreach my $code ( sort keys %encoded ) {
    134  1.1.1.1.2.2  martin             printf "%s = %s\n", $code, $encoded{$code};
    135  1.1.1.1.2.2  martin         }
    136  1.1.1.1.2.2  martin     }
    137  1.1.1.1.2.2  martin }
    138  1.1.1.1.2.2  martin 
    139  1.1.1.1.2.2  martin sub main::HELP_MESSAGE() {
    140  1.1.1.1.2.2  martin     printf STDERR <<EOF
    141  1.1.1.1.2.2  martin Usage: $0 [options]
    142  1.1.1.1.2.2  martin 
    143  1.1.1.1.2.2  martin Options:
    144  1.1.1.1.2.2  martin 	-b NUM	set the number of buttons (default: 7)
    145  1.1.1.1.2.2  martin 	-i	invert the report to show code for each combination
    146  1.1.1.1.2.2  martin 	-x	eliminate 1-byte limit for codes
    147  1.1.1.1.2.2  martin EOF
    148  1.1.1.1.2.2  martin       ;
    149  1.1.1.1.2.2  martin     exit 1;
    150  1.1.1.1.2.2  martin }
    151  1.1.1.1.2.2  martin $Getopt::Std::STANDARD_HELP_VERSION = 1;
    152  1.1.1.1.2.2  martin &getopts('b:ix') || &main::HELP_MESSAGE;
    153  1.1.1.1.2.2  martin $maxbutton = $opt_b if ( defined $opt_b );
    154  1.1.1.1.2.2  martin &main::HELP_MESSAGE if ( $maxbutton !~ /^\d+$/ );
    155  1.1.1.1.2.2  martin $#ARGV < 0 || &main::HELP_MESSAGE;
    156  1.1.1.1.2.2  martin 
    157  1.1.1.1.2.2  martin &report;
    158  1.1.1.1.2.2  martin 
    159  1.1.1.1.2.2  martin 1;
    160