Чтение мышиного события на консоле - PullRequest
1 голос
/ 13 января 2011
#!/usr/bin/env perl
use warnings;
use 5.012;
binmode STDOUT, ':encoding(UTF-8)';
use Term::ReadKey;

sub getch {
    my $tty_in = shift;
    my $c = ReadKey 0, $tty_in;
    if ( $c eq "\e" ) {
        my $c = ReadKey 0.10, $tty_in;
        if ( $c eq '[' ) {
            my $c = ReadKey 0, $tty_in;
            if ( $c eq 'M' ) {   
                my $event_type = ord( ReadKey 0, $tty_in ) - 32;
                my $x = ord( ReadKey 0, $tty_in ) - 32;
                my $y = ord( ReadKey 0, $tty_in ) - 32;
                return $x, $y;
            }
        }
    }
}

#--------------------------------------------------------------
open my $tty_in, '<:encoding(utf-8)', '/dev/tty' or die $!;
Term::ReadKey::ReadMode 'ultra-raw', $tty_in;

# enter_mouse_mode
close $tty_in;
open $tty_in, '<:bytes', '/dev/tty' or die $!;
print "\e[?1003h";   # sets   SET_ANY_EVENT_MOUSE  mode

my( $x, $y ) = getch( $tty_in );

# leave_mouse_mode
close $tty_in;
open $tty_in, '<:encoding(utf-8)', '/dev/tty' or die $!;
print "\e[?1003l";   # cancels SET_ANY_EVENT_MOUSE mode

Term::ReadKey::ReadMode 'restore', $tty_in;
close $tty_in;
#----------------------------------------------------------------
say "x = $x";
say "y = $y";

Я попытался переместить отмеченную часть из «open $ tty_in» в «STDIN», но она пока не работает. Когда "x" становится больше, чем "95" (127-32), я получаю сообщение об ошибке (utf8 "\ x80" не отображается в Unicode в строке (eval 1) ...). Как мне изменить запасную часть, чтобы она заработала?

binmode STDIN, ':encoding(utf-8)' or die $!;
Term::ReadKey::ReadMode 'ultra-raw';

# enter_mouse_mode
binmode STDIN, ':bytes' or die $!;
print "\e[?1003h";

my( $x, $y ) = getch( *STDIN );

# leave_mouse_mode
binmode STDIN, ':encoding(utf-8)' or die $!;
print "\e[?1003l";
Term::ReadKey::ReadMode 'restore';

1 Ответ

1 голос
/ 13 января 2011

Я должен изменить

binmode STDIN, ':bytes' or die $!;

с

binmode STDIN, ':pop:bytes' or die $!;

или с

binmode STDIN, ':raw' or die $!;

тогда это работает.

...