package Term::Choose::Linux;
use warnings;
use strict;
use 5.008003;
our $VERSION = '1.511';
use Term::ReadKey qw( GetTerminalSize ReadKey ReadMode );
use Term::Choose::Constants qw( :linux );
sub new {
return bless {}, $_[0];
}
sub __get_key_OS {
my ( $self, $mouse ) = @_;
my $c1 = ReadKey( 0 );
return if ! defined $c1;
if ( $c1 eq "\e" ) {
my $c2 = ReadKey( 0.10 );
if ( ! defined $c2 ) { return KEY_ESC; } # unused
#elsif ( $c3 eq 'A' ) { return VK_UP; } vt 52
#elsif ( $c3 eq 'B' ) { return VK_DOWN; }
#elsif ( $c3 eq 'C' ) { return VK_RIGHT; }
#elsif ( $c3 eq 'D' ) { return VK_LEFT; }
#elsif ( $c3 eq 'H' ) { return VK_HOME; }
elsif ( $c2 eq 'O' ) {
my $c3 = ReadKey( 0 );
if ( $c3 eq 'A' ) { return VK_UP; }
elsif ( $c3 eq 'B' ) { return VK_DOWN; }
elsif ( $c3 eq 'C' ) { return VK_RIGHT; }
elsif ( $c3 eq 'D' ) { return VK_LEFT; }
elsif ( $c3 eq 'F' ) { return VK_END; }
elsif ( $c3 eq 'H' ) { return VK_HOME; }
elsif ( $c3 eq 'Z' ) { return KEY_BTAB; }
else {
return NEXT_get_key;
}
}
elsif ( $c2 eq '[' ) {
my $c3 = ReadKey( 0 );
if ( $c3 eq 'A' ) { return VK_UP; }
elsif ( $c3 eq 'B' ) { return VK_DOWN; }
elsif ( $c3 eq 'C' ) { return VK_RIGHT; }
elsif ( $c3 eq 'D' ) { return VK_LEFT; }
elsif ( $c3 eq 'F' ) { return VK_END; }
elsif ( $c3 eq 'H' ) { return VK_HOME; }
elsif ( $c3 eq 'Z' ) { return KEY_BTAB; }
elsif ( $c3 =~ m/^[0-9]$/ ) {
my $c4 = ReadKey( 0 );
if ( $c4 eq '~' ) {
if ( $c3 eq '2' ) { return VK_INSERT; } # unused
elsif ( $c3 eq '3' ) { return VK_DELETE; } # unused
elsif ( $c3 eq '5' ) { return VK_PAGE_UP; }
elsif ( $c3 eq '6' ) { return VK_PAGE_DOWN; }
else {
return NEXT_get_key;
}
}
elsif ( $c4 =~ m/^[;0-9]$/ ) { # response to "\e[6n"
my $abs_curs_y = $c3;
my $ry = $c4;
while ( $ry =~ m/^[0-9]$/ ) {
$abs_curs_y .= $ry;
$ry = ReadKey( 0 );
}
return NEXT_get_key if $ry ne ';';
my $abs_curs_x = '';
my $rx = ReadKey( 0 );
while ( $rx =~ m/^[0-9]$/ ) {
$abs_curs_x .= $rx;
$rx = ReadKey( 0 );
}
if ( $rx eq 'R' ) {
#$self->{abs_cursor_x} = $abs_curs_x; # unused
$self->{abs_cursor_y} = $abs_curs_y;
}
return NEXT_get_key;
}
else {
return NEXT_get_key;
}
}
# http://invisible-island.net/xterm/ctlseqs/ctlseqs.html
elsif ( $c3 eq 'M' && $mouse ) {
my $event_type = ord( ReadKey( 0 ) ) - 32;
my $x = ord( ReadKey( 0 ) ) - 32;
my $y = ord( ReadKey( 0 ) ) - 32;
my $button = $self->__mouse_event_to_button( $event_type );
return NEXT_get_key if $button == NEXT_get_key;
return [ $self->{abs_cursor_y}, $button, $x, $y ];
}
elsif ( $c3 eq '<' && $mouse ) { # SGR 1006
my $event_type = '';
my $m1;
while ( ( $m1 = ReadKey( 0 ) ) =~ m/^[0-9]$/ ) {
$event_type .= $m1;
}
return NEXT_get_key if $m1 ne ';';
my $x = '';
my $m2;
while ( ( $m2 = ReadKey( 0 ) ) =~ m/^[0-9]$/ ) {
$x .= $m2;
}
return NEXT_get_key if $m2 ne ';';
my $y = '';
my $m3;
while ( ( $m3 = ReadKey( 0 ) ) =~ m/^[0-9]$/ ) {
$y .= $m3;
}
return NEXT_get_key if $m3 !~ m/^[mM]$/;
my $button_released = $m3 eq 'm' ? 1 : 0;
return NEXT_get_key if $button_released;
my $button = $self->__mouse_event_to_button( $event_type );
return NEXT_get_key if $button == NEXT_get_key;
return [ $self->{abs_cursor_y}, $button, $x, $y ];
}
else {
return NEXT_get_key;
}
}
else {
return NEXT_get_key;
}
}
else {
return ord $c1;
}
};
sub __mouse_event_to_button {
my ( $self, $event_type ) = @_;
my $button_drag = ( $event_type & 0x20 ) >> 5;
return NEXT_get_key if $button_drag;
my $button;
my $low_2_bits = $event_type & 0x03;
if ( $low_2_bits == 3 ) {
$button = 0;
}
else {
if ( $event_type & 0x40 ) {
$button = $low_2_bits + 4; # 4,5
}
else {
$button = $low_2_bits + 1; # 1,2,3
}
}
return $button;
}
sub __set_mode {
my ( $self, $mouse, $hide_cursor ) = @_;
if ( $mouse ) {
if ( $mouse == 3 ) {
my $return = binmode STDIN, ':utf8';
if ( $return ) {
print SET_ANY_EVENT_MOUSE_1003;
print SET_EXT_MODE_MOUSE_1005;
}
else {
$mouse = 0;
warn "binmode STDIN, :utf8: $!\n";
warn "mouse-mode disabled\n";
}
}
elsif ( $mouse == 4 ) {
my $return = binmode STDIN, ':raw';
if ( $return ) {
print SET_ANY_EVENT_MOUSE_1003;
print SET_SGR_EXT_MODE_MOUSE_1006;
}
else {
$mouse = 0;
warn "binmode STDIN, :raw: $!\n";
warn "mouse-mode disabled\n";
}
}
else {
my $return = binmode STDIN, ':raw';
if ( $return ) {
print SET_ANY_EVENT_MOUSE_1003;
}
else {
$mouse = 0;
warn "binmode STDIN, :raw: $!\n";
warn "mouse-mode disabled\n";
}
}
}
Term::ReadKey::ReadMode( 'ultra-raw' );
print HIDE_CURSOR if $hide_cursor;
return $mouse;
};
sub __reset_mode {
my ( $self, $mouse, $hide_cursor ) = @_;
print SHOW_CURSOR if $hide_cursor;
if ( $mouse ) {
binmode STDIN, ':encoding(UTF-8)' or warn "binmode STDIN, :encoding(UTF-8): $!\n";
print UNSET_EXT_MODE_MOUSE_1005 if $mouse == 3;
print UNSET_SGR_EXT_MODE_MOUSE_1006 if $mouse == 4;
print UNSET_ANY_EVENT_MOUSE_1003;
}
$self->__reset();
Term::ReadKey::ReadMode( 'restore' );
}
sub __get_term_size {
#my ( $self ) = @_;
my ( $width, $height ) = ( GetTerminalSize() )[ 0, 1 ];
return $width - WIDTH_CURSOR, $height;
# $width - WIDTH_CURSOR: don't let items reach the right edge of the terminal;
# selecting an item which reaches the right edge of the terminal
# messes up the output - maybe because the (hidden) terminal-cursor needs a space
}
sub __get_cursor_position {
my ( $self ) = @_;
#$self->{abs_cursor_x} = 0; # unused
$self->{abs_cursor_y} = 0;
print GET_CURSOR_POSITION;
}
sub __clear_screen {
#my ( $self ) = @_;
print CLEAR_SCREEN;
}
sub __clear_to_end_of_screen {
#my ( $self ) = @_;
print CLEAR_TO_END_OF_SCREEN;
}
sub __bold_underline {
#my ( $self ) = @_;
print BOLD_UNDERLINE;
}
sub __reverse {
#my ( $self ) = @_;
print REVERSE;
}
sub __reset {
#my ( $self ) = @_;
print RESET;
}
sub __up {
#my ( $self ) = @_;
print "\e[${_[1]}A";
}
sub __left {
#my ( $self ) = @_;
print "\e[${_[1]}D";
}
sub __right {
#my ( $self ) = @_;
print "\e[${_[1]}C";
}
1;
__END__