use warnings;
use strict;
use 5.10.1;
use utf8;
package Term::Choose;

our $VERSION = '0.7';
use Exporter 'import';
our @EXPORT_OK = qw(choose);

use Carp;
use Scalar::Util qw(reftype);
use Signals::XSIG;
use Term::ReadKey;
# ----- #

#use warnings FATAL => qw(all);
#use Log::Log4perl qw(get_logger);
#my $log = get_logger("Term::Choose");


use constant {
    ROW         => 0,
    COL         => 1,
};

use constant {
    UP                                 => "\e[A",
    DOWN                               => "\n",
    RIGHT                              => "\e[C",
    CR                                 => "\r",
    GET_CURSOR_POSITION                => "\e[6n",
    
    HIDE_CURSOR                        => "\e[?25l",
    SHOW_CURSOR                        => "\e[?25h", 

    SET_ANY_EVENT_MOUSE_1003           => "\e[?1003h",
    SET_EXT_MODE_MOUSE_1005            => "\e[?1005h",
    SET_SGR_EXT_MODE_MOUSE_1006        => "\e[?1006h",
    UNSET_ANY_EVENT_MOUSE_1003         => "\e[?1003l",
    UNSET_EXT_MODE_MOUSE_1005          => "\e[?1005l",
    UNSET_SGR_EXT_MODE_MOUSE_1006      => "\e[?1006l",
    
    MAX_MOUSE_1003_ROW                 => 224,
    MAX_MOUSE_1003_COL                 => 224,     

    BEEP                               => "\07",
    CLEAR_SCREEN                       => "\e[2J",
    GO_TO_TOP_LEFT                     => "\e[0;0H",
    CLEAR_EOS                          => "\e[0J",
    RESET                              => "\e[0m",
    UNDERLINE                          => "\e[4m",
    REVERSE                            => "\e[7m",
    BOLD                               => "\e[1m",
};

use constant {
    BIT_MASK_xxxxxx11    => 0b00000011,
    BIT_MASK_xx1xxxxx    => 0b00100000,
    BIT_MASK_x1xxxxxx    => 0b01000000,
};

use constant {
    NEXT_getch          => -1,
    CONTROL_c           => 3, 
    KEY_TAB             => 9,
    KEY_ENTER           => 13, # CR
    KEY_ESC             => 27,
    KEY_SPACE           => 32,
    KEY_b               => 98,
    KEY_h               => 104,
    KEY_j               => 106,
    KEY_k               => 107,
    KEY_l               => 108,
    KEY_q               => 113,
    KEY_Tilde           => 126,
    KEY_BSPACE          => 127,
   
    KEY_UP              => 279165,
    KEY_DOWN            => 279166,
    KEY_RIGHT           => 279167,
    KEY_LEFT            => 279168,
    KEY_BTAB            => 279190,
};


sub _validate_option {
    my ( $config ) = @_;
    my %validate = (
        prompt          => '',
        right_justify   => qr/\A(?:0|1)\z/,
        layout          => qr/\A(?:0|1|2|3)\z/,
        vertical_order  => qr/\A(?:0|1)\z/, 
        auto_format     => qr/\A(?:0|1|2|3)\z/,
        clear_screen    => qr/\A(?:0|1)\z/,
        mouse_mode      => qr/\A(?:0|1|2|3|4)\z/,
        pad             => qr/\A[0-9]+\z/,
        pad_one_row     => qr/\A[0-9]+\z/,
        extra_key       => qr/\A(?:0|1)\z/,
        beep            => qr/\A(?:0|1)\z/,
        empty_string    => '',
        undef_element   => '',
        max_list        => qr/\A[1-9][0-9]*\z/,
    );
    for my $key ( keys %$config ) {
        if ( $validate{$key} ) {
            if ( defined $config->{$key} and not $config->{$key} =~ $validate{$key} ) {
                print "\n";
                carp "\"$config->{$key}\" not a valid value for option \"$key\". Falling back to default-value.";
                print "\n";
                $config->{$key} = undef;
            }
        }
        elsif ( not exists $validate{$key} ) {
            print "\n";        
            carp "\"$key\": no such option";
            print "\n";
            delete $config->{$key};
        }
    }
    return $config;
}
        

sub _set_layout {
    my $config = shift // {};
    $config = _validate_option( $config );
    $config->{prompt}           //= 'Your choice:';       
    $config->{right_justify}    //= 0; # 0,1
    $config->{layout}           //= 1; # 0,1,2,3
    $config->{vertical_order}   //= 1; # 0,1
    $config->{auto_format}      //= 1; # 0,1,2,3
    $config->{clear_screen}     //= 0; # 0,1
    $config->{mouse_mode}       //= 1; # 0,1,2,3,4
    $config->{pad}              //= 2; # \d+ 
    $config->{pad_one_row}      //= 3; # \d+ 
    $config->{extra_key}        //= 1; # 0,1
    $config->{beep}             //= 1; # 0,1
    $config->{empty_string}     //= '<empty>';
    $config->{undef_element}    //= '<undef>';
    $config->{max_list}         //= 100000;
    return $config;
}

$ENV{CLUI_MOUSE} = $ENV{CLUI_MOUSE} || ''; 


sub _getch {
    my ( $arg ) = @_;
    my $c = ReadKey 0;
    if ( $c eq "\e" ) {
        my $c = ReadKey 0.10;
        if ( not  defined $c ) { return KEY_ESC; }
        elsif ( $c eq 'A' ) { return KEY_UP; }
        elsif ( $c eq 'B' ) { return KEY_DOWN; }
        elsif ( $c eq 'C' ) { return KEY_RIGHT; }
        elsif ( $c eq 'D' ) { return KEY_LEFT; }
        elsif ( $c eq 'Z' ) { return KEY_BTAB; }
        elsif ( $c eq '[' ) {
            my $c = ReadKey 0;
               if ( $c eq 'A' ) { return KEY_UP; }
            elsif ( $c eq 'B' ) { return KEY_DOWN; }
            elsif ( $c eq 'C' ) { return KEY_RIGHT; }
            elsif ( $c eq 'D' ) { return KEY_LEFT; }
            elsif ( $c eq 'Z' ) { return KEY_BTAB; }
            elsif ( $c eq 'M' ) {       
                # http://invisible-island.net/xterm/ctlseqs/ctlseqs.html
                my $event_type  = ord( ReadKey 0 ) - 32;        # byte 4
                my $x           = ord( ReadKey 0 ) - 32;        # byte 5
                my $y           = ord( ReadKey 0 ) - 32;        # byte 6
                my $button_drag = ( $event_type & BIT_MASK_xx1xxxxx ) >> 5;
                my $button_pressed;
                my $low_2_bits = $event_type & BIT_MASK_xxxxxx11;
                if ( $low_2_bits == 3 ) {
                    $button_pressed = 0;
                } 
                else {  
                    if ( $event_type & BIT_MASK_x1xxxxxx ) { 
                        $button_pressed = $low_2_bits + 4; # button 4, 5
                    } 
                    else { 
                        $button_pressed = $low_2_bits + 1; # button 1, 2, 3
                    }
                }
                return _handle_mouse( $x, $y, $button_pressed, $button_drag, $arg );
            }
            elsif ( $c =~ /\A\d/ ) { 
                my $c1 = ReadKey 0;
                if ( $c1 eq '~' ) {
                    return NEXT_getch;
                }
                else {   # cursor-position report, response to \e[6n
                    $arg->{abs_curs_Y} = 0 + $c;
                    while ( 1 ) {
                        last if $c1 eq ';';
                        $arg->{abs_curs_Y} = 10 * $arg->{abs_curs_Y} + $c1;
                        $c1 = ReadKey 0;
                    }
                    $arg->{abs_curs_X} = 0;
                    while ( 1 ) {
                        $c1 = ReadKey 0;
                        last if $c1 eq 'R';
                        $arg->{abs_curs_X} = 10 * $arg->{abs_curs_X} + $c1;
                    }
                    return NEXT_getch;
                }
            }
            else {
                return NEXT_getch;            
            }
        }
        else {
            return NEXT_getch;
        }
    } 
    else {
        return ord $c;
    }
}


sub _init_scr { 
    my ( $arg ) = @_;
    $arg->{old_handle} = select( $arg->{handle_out} );
    $|++;
    if ( $arg->{mouse_mode} and not $ENV{CLUI_MOUSE} =~ /off/i ) {
        if ( $arg->{mouse_mode} == 3 ) {
            my $return = binmode STDIN, ':utf8';
            if ( $return ) {
                print SET_ANY_EVENT_MOUSE_1003;
                print SET_EXT_MODE_MOUSE_1005;
            }
            else {
                $arg->{mouse_mode} = 0;
                warn "binmode STDIN, :utf8: $!\n";
                warn "mouse-mode disabled\n";
            }
        } 
        elsif ( $arg->{mouse_mode} == 4 ) {
            my $return = binmode STDIN, ':raw';
            if ( $return ) {
                print SET_ANY_EVENT_MOUSE_1003;
                print SET_SGR_EXT_MODE_MOUSE_1006;
            }
            else {
                $arg->{mouse_mode} = 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 {
                $arg->{mouse_mode} = 0;
                warn "binmode STDIN, :raw: $!\n";
                warn "mouse-mode disabled\n";
            }
        }
    }
    print HIDE_CURSOR; 
    Term::ReadKey::ReadMode 'ultra-raw';
}

sub _end_win {
    my ( $arg ) = @_;
    print CR, UP x ( $arg->{row_total} + $arg->{head} );
    _clear_to_end_of_screen( $arg );
    print RESET;
    if ( $arg->{mouse_mode} and not $ENV{CLUI_MOUSE} =~ /off/i ) {
        binmode STDIN, ':encoding(utf-8)' or warn "binmode STDIN, :encoding(utf-8): $!\n";
        print UNSET_EXT_MODE_MOUSE_1005         if $arg->{mouse_mode} == 3;
        print UNSET_SGR_EXT_MODE_MOUSE_1006     if $arg->{mouse_mode} == 4; 
        print UNSET_ANY_EVENT_MOUSE_1003;
    }
    Term::ReadKey::ReadMode 'restore';
    print SHOW_CURSOR; 
    select( $arg->{old_handle} );
}


sub _length_longest {
    my ( $list ) = @_;
    # ----- #
    my $longest = length $list->[0];    # ----- #
    for my $str ( @{$list} ) {
        # ----- #
        if ( length $str > $longest ) { # ----- #
            $longest = length $str;     # ----- #
        }
    }
    return $longest;
}


sub _write_first_screen {
    my ( $arg ) = @_;
    if ( $arg->{clear_screen} ) {
        print CLEAR_SCREEN;
        print GO_TO_TOP_LEFT;
    }
    ( $arg->{maxcols}, $arg->{maxrows} ) = GetTerminalSize( $arg->{handle_out} );
    if ( $arg->{mouse_mode} == 2 ) {
	$arg->{maxcols} = MAX_MOUSE_1003_COL if $arg->{maxcols} > MAX_MOUSE_1003_COL;
        $arg->{maxrows} = MAX_MOUSE_1003_ROW if $arg->{maxrows} > MAX_MOUSE_1003_ROW;
    }
    $arg->{head} = 0;
    _goto( $arg, $arg->{head}, 0 );
    _clear_to_end_of_screen( $arg );
    if ( $arg->{prompt} ne '0' ) {
        $arg->{firstline} = $arg->{prompt};
        # ----- #
        if ( $arg->{wantarray} ) {
            $arg->{firstline} = $arg->{prompt} . '  (multiple choice with spacebar)';  
            $arg->{firstline} = $arg->{prompt} . ' (multiple choice)' if length $arg->{firstline} > $arg->{maxcols};    # ----- #
        }
        if ( length $arg->{firstline} > $arg->{maxcols} ) {                     # ----- #
            # ----- #
            $arg->{firstline} = substr( $arg->{prompt}, 0, $arg->{maxcols} );   # ----- #
        }
        print $arg->{firstline};
        $arg->{head}++;
    }
    $arg->{maxrows} -= $arg->{head};
    $arg->{marked} = [];
    _size_and_layout( $arg );
    $arg->{available} = $arg->{maxrows} - 1;
    $arg->{begin_page} = 0;
    $arg->{end_page} = $arg->{available};
    $arg->{end_page} = $#{$arg->{new_list}} if $arg->{available} > $#{$arg->{new_list}};
    ( $arg->{page}, $arg->{row_total} ) = ( 0, 0 );
    _wr_screen( $arg );
    print GET_CURSOR_POSITION;  # in: $arg->{abs_curs_X}, $arg->{abs_curs_Y} 
    $arg->{size_changed} = 0;
}

sub copy_orig_list {
    my ( $arg ) = @_;
    return [ map {
        my $copy = $_;
        $copy = ( not defined $copy ) ? $arg->{undef_element} : $copy;
        $copy = ( $copy eq '' )       ? $arg->{empty_string}  : $copy;        
        $copy =~ s/\n/ /g;
        $copy =~ s/\t/ /g;
        $copy; # " $copy ";
    } @{$arg->{orig_list}} ];
}


sub choose { 
    my ( $orig_list, $config ) = @_;
    my $arg = _set_layout( $config );
    if ( not defined $orig_list ) {
        carp "No Argument!";
        print "\n";
        return;
    }
    elsif ( not reftype( $orig_list ) ) {
        carp "List has to be a Reference";
        print "\n";
        return;
    }
    elsif ( not reftype( $orig_list ) eq 'ARRAY' ) {
        carp "List Argument has to be a Array Reference!";
        print "\n";
        return;
    }
    elsif ( not @$orig_list ) {
        carp "List is empty!";
        print "\n";
        return;
    }
    elsif ( @$orig_list > $arg->{max_list} ) {
        carp "List is to big!\nLists with more then $arg->{max_list} items not alowed!";
        print "\n";
        return;
    }
    $arg->{orig_list} = $orig_list;
    $arg->{handle_out} = -t \*STDOUT ? \*STDOUT : \*STDERR;
    $arg->{list} = copy_orig_list( $arg );
    $arg->{length_longest} = _length_longest( $arg->{list} );
    $arg->{col_width} = $arg->{length_longest} + $arg->{pad};
    $arg->{wantarray} = wantarray ? 1 : 0;
    # $arg->{LastEventWasPress} = 0;  # in order to ignore left-over button-ups # orig comment
    $arg->{abs_curs_X} = 0;
    $arg->{abs_curs_Y} = 0;
    $arg->{irow} = 0;
    $arg->{this_cell} = [];
    _init_scr( $arg );
    _write_first_screen( $arg );
    $XSIG{WINCH}[5] = sub { $arg->{size_changed} = 1; };
    while ( 1 ) {
        my $c = _getch( $arg );
        next if $c == NEXT_getch;
        next if $c == KEY_Tilde;
        if ( $arg->{size_changed} ) {
            $arg->{list} = copy_orig_list( $arg );
            _write_first_screen( $arg );
            next;
        }
        for ( $c ) {
            when ( $c == KEY_j or $c == KEY_DOWN ) {
                if ( $#{$arg->{new_list}} == 0 or not ( $arg->{new_list}[$arg->{this_cell}[ROW]+1] and $arg->{new_list}[$arg->{this_cell}[ROW]+1][$arg->{this_cell}[COL]] ) ) {
                    _beep( $arg );
                } 
                else {
                    $arg->{row_total}++;
                    if ( $arg->{this_cell}[ROW] + 1 <= $arg->{end_page} ) {
                        $arg->{this_cell}[ROW]++;
                        _wr_cell( $arg, $arg->{this_cell}[ROW] - 1, $arg->{this_cell}[COL] );
                        _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] );
                    } 
                    else {
                        $arg->{page} = $arg->{row_total};
                        $arg->{end_page}++;
                        $arg->{begin_page} = $arg->{end_page};
                        if ( $arg->{end_page} + $arg->{available} > $#{$arg->{new_list}} ) {
                            $arg->{end_page} = $#{$arg->{new_list}};
                        } 
                        else {
                            $arg->{end_page} += $arg->{available};
                        }
                        $arg->{this_cell}[ROW]++;
                        _wr_screen( $arg );
                    }
                }
            }
            when ( $c == KEY_k or $c == KEY_UP ) {
                if ( $arg->{this_cell}[ROW] == 0 ) {
                    _beep( $arg );
                } 
                else {
                    $arg->{row_total}--;
                    if ( $arg->{this_cell}[ROW] - 1 >= $arg->{begin_page} ) {
                        $arg->{this_cell}[ROW]--;
                        _wr_cell( $arg, $arg->{this_cell}[ROW] + 1, $arg->{this_cell}[COL] );
                        _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] );
                    } 
                    else {
                        $arg->{begin_page}--;
                        $arg->{page} = $arg->{row_total} - $arg->{available};
                        $arg->{end_page} = $arg->{begin_page};
                        if ( $arg->{begin_page} - $arg->{available} < 0 ) {
                                $arg->{begin_page} = 0;
                        } 
                        else {
                                $arg->{begin_page} = $arg->{begin_page} - $arg->{available};
                        }
                        $arg->{this_cell}[ROW]--;
                        _wr_screen( $arg );
                    }
                }
            }
            when ( $c == KEY_TAB ) {
                if ( $arg->{this_cell}[COL] == $#{$arg->{new_list}[$arg->{this_cell}[ROW]]} and $arg->{this_cell}[ROW] == $#{$arg->{new_list}} ) {
                    _beep( $arg );
                } 
                else {
                    if ( $arg->{this_cell}[COL] < $#{$arg->{new_list}[$arg->{this_cell}[ROW]]} ) {
                        $arg->{this_cell}[COL]++;
                        _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] - 1 );
                        _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] );
                    }
                    else {
                        $arg->{row_total}++;
                        if ( $arg->{this_cell}[ROW] + 1 <= $arg->{end_page} ) {
                            $arg->{this_cell}[ROW]++;
                            $arg->{this_cell}[COL] = 0;
                            _wr_cell( $arg, $arg->{this_cell}[ROW] - 1, $#{$arg->{new_list}[$arg->{this_cell}[ROW] - 1]} );
                            _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] );
                        } 
                        else {
                            $arg->{page} = $arg->{row_total};
                            $arg->{end_page}++;
                            $arg->{begin_page} = $arg->{end_page};
                            if ( $arg->{end_page} + $arg->{available} > $#{$arg->{new_list}} ) {
                                $arg->{end_page} = $#{$arg->{new_list}};
                            } 
                            else {
                                $arg->{end_page} += $arg->{available};
                            }
                            $arg->{this_cell}[ROW]++;
                            $arg->{this_cell}[COL] = 0;
                            _wr_screen( $arg );
                        }
                    }
                }
            }
            when ( ( $c == KEY_BSPACE or $c == KEY_BTAB ) and ( $arg->{this_cell} > 0 ) ) {
                if ( $arg->{this_cell}[COL] == 0 and $arg->{this_cell}[ROW] == 0 ) {
                    _beep( $arg );
                } 
                else {
                    if ( $arg->{this_cell}[COL] > 0 ) {
                        $arg->{this_cell}[COL]--;
                        _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] + 1 );
                        _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] );
                    }
                    else {
                        $arg->{row_total}--;
                        if ( $arg->{this_cell}[ROW] - 1 >= $arg->{begin_page} ) {
                            $arg->{this_cell}[ROW]--;
                            $arg->{this_cell}[COL] = $#{$arg->{new_list}[$arg->{this_cell}[ROW]]};
                            _wr_cell( $arg, $arg->{this_cell}[ROW] + 1, 0 );
                            _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] );
                        } 
                        else {
                            $arg->{page} = $arg->{row_total} - $arg->{available};
                            $arg->{begin_page}--;
                            $arg->{end_page} = $arg->{begin_page};
                            if ( $arg->{begin_page} - $arg->{available} < 0 ) {
                                $arg->{begin_page} = 0;
                            } 
                            else {
                                $arg->{begin_page} = $arg->{begin_page} - $arg->{available};
                            }
                            $arg->{this_cell}[ROW]--;
                            $arg->{this_cell}[COL] = $#{$arg->{new_list}[$arg->{this_cell}[ROW]]};
                            _wr_screen( $arg );
                        }
                    }
                }
            }
            when ( $c == KEY_l or $c == KEY_RIGHT ) {
                if ( $arg->{this_cell}[COL] == $#{$arg->{new_list}[$arg->{this_cell}[ROW]]} ) {
                    _beep( $arg );
                }
                else {
                    $arg->{this_cell}[COL]++;
                    _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] - 1 );
                    _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] );
                }
            }
            when ( $c == KEY_h or $c == KEY_LEFT ) {
                if ( $arg->{this_cell}[COL] == 0 ) {
                    _beep( $arg );
                }
                else {
                    $arg->{this_cell}[COL]--;
                    _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] + 1 );
                    _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] );
                }
            }
            when ( $c == KEY_b ) {
                if ( $arg->{extra_key} ) {
                    _end_win( $arg );    
                    return 'BACK';
                }
                else {
                    _beep( $arg );
                }
            }
            when ( $c == KEY_q ) {
                _end_win( $arg );
                return 'QUIT' if $arg->{extra_key};
                return;
            }
            when ( $c == CONTROL_c ) {
                _end_win( $arg );
                print "^C";
                kill( 'INT', $$ );
                return;
            }
            when ( $c == KEY_ENTER ) {
                my @chosen;
                _end_win( $arg );
                if ( $arg->{wantarray} ) {
                    for my $col ( 0 .. $#{$arg->{new_list}[0]} ) {
                        for my $row ( 0 .. $#{$arg->{new_list}} ) {
                            if ( $arg->{marked}[$row][$col] or [ $row, $col ] ~~ $arg->{this_cell} ) {
                                my $i = $arg->{rowcol_to_list_index}[$row][$col];
                                $i //= $row; # $layout
                                push @chosen, $arg->{orig_list}[$i];
                            }
                        }
                    }
                    return @chosen;
                } 
                else {
                    my $i = $arg->{rowcol_to_list_index}[$arg->{this_cell}[ROW]][$arg->{this_cell}[COL]];
                    return $arg->{orig_list}[$i];
                }
            }
            when ( $c == KEY_SPACE ) {
                if ( $arg->{wantarray} ) {
                    if ( not $arg->{marked}[$arg->{this_cell}[ROW]][$arg->{this_cell}[COL]] ) {
                        $arg->{marked}[$arg->{this_cell}[ROW]][$arg->{this_cell}[COL]] = 1;
                    } 
                    else {
                        $arg->{marked}[$arg->{this_cell}[ROW]][$arg->{this_cell}[COL]] = 0;
                    }
                    _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] ); 
                }
            }
            default {
                _beep( $arg );
            }
        }
    }
    _end_win( $arg );
    warn "choose: shouldn't reach here ...\n";
}

sub _beep { 
    my ( $arg ) = @_;
    print BEEP if $arg->{beep};
} 
sub _clear_to_end_of_screen {
    my ( $arg ) = @_;
    print CLEAR_EOS; 
}

sub _goto { 
    my ( $arg, $newrow, $newcol ) = @_;
    print CR, RIGHT x $newcol;
    if ( $newrow > $arg->{irow} ) { 
        print DOWN x ( $newrow - $arg->{irow} );
        $arg->{irow} += ( $newrow - $arg->{irow} );
    } 
    elsif ( $newrow < $arg->{irow} ) { 
        print UP x ( $arg->{irow} - $newrow );
        $arg->{irow} -= ( $arg->{irow} - $newrow );
    }
}

sub _wr_screen {
    my $arg = shift;
    _goto( $arg, $arg->{head}, 0 );
    _clear_to_end_of_screen( $arg );
    for my $row ( $arg->{begin_page} .. $arg->{end_page} ) {
        for my $col ( 0 .. $#{$arg->{new_list}[$row]} ) {
            _wr_cell( $arg, $row, $col ); # unless [ $row, $col ] ~~ $this_cell;
        }
    }
    _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] );
}


sub _wr_cell {
    my( $arg, $row, $col ) = @_;
    if ( $#{$arg->{new_list}} == 0 ) {
        my $lngth = 0;
        if ( $col > 0 ) {
            for my $cl ( 0 .. $col - 1 ) {
                # ----- #
                $lngth += length $arg->{new_list}[$row][$cl];   # ----- #
                $lngth += $arg->{pad_one_row} // 0;
            }
        }
        _goto( $arg, $row + $arg->{head} - $arg->{page}, $lngth );
    } 
    else {
        _goto( $arg, $row + $arg->{head} - $arg->{page}, $col * $arg->{col_width} );
    }
    print BOLD, UNDERLINE if $arg->{marked}[$row][$col];
    print REVERSE if [ $row, $col ] ~~ $arg->{this_cell};
    print $arg->{new_list}[$row][$col]; 
    print RESET if $arg->{marked}[$row][$col] or [ $row, $col ] ~~ $arg->{this_cell};
}


sub _size_and_layout {
    my ( $arg ) = @_;
    my $layout = $arg->{layout};
    $arg->{new_list} = [];
    $arg->{rowcol_to_list_index} = [];
    $arg->{all_in_first_row} = 0;
    if ( $arg->{length_longest} > $arg->{maxcols} ) {
        $arg->{length_longest} = $arg->{maxcols};
        $layout = 3;
    }
    # layout
    $arg->{this_cell} = [ 0, 0 ]; 
    my $all_in_first_row;
    if ( $layout == 2 ) {
        $layout = 3 if scalar @{$arg->{list}} <= $arg->{maxrows};
    }
    elsif ( $layout < 2 ) {
        for my $element ( 0 .. $#{$arg->{list}} ) {
            $all_in_first_row .= $arg->{list}[$element];
            $all_in_first_row .= ' ' x $arg->{pad_one_row};
            # ----- #
            if ( length $all_in_first_row > $arg->{maxcols} ) { # ----- #
                $all_in_first_row = '';
                last;
            }
        }
    }
    if ( $all_in_first_row ) {
	$arg->{all_in_first_row} = 1;
	$arg->{new_list}[0] = [ @{$arg->{list}} ];
        $arg->{rowcol_to_list_index}[0] = [ 0 .. $#{$arg->{list}} ];	
    } 
    elsif ( $layout == 3 ) { 
        for my $idx ( 0 .. $#{$arg->{list}} ) {
            # ----- #
            if ( length $arg->{list}[$idx] > $arg->{length_longest} ) {                                      # ----- #
                $arg->{list}[$idx] = substr( $arg->{list}[$idx], 0, $arg->{length_longest} - 3 ) . '...';    # ----- #
            }
            $arg->{new_list}[$idx][0] = sprintf "%*.*s",  $arg->{length_longest}, $arg->{length_longest}, $arg->{list}[$idx] if $arg->{right_justify};   # ----- # unicode_sprintf
            $arg->{new_list}[$idx][0] = sprintf "%-*.*s", $arg->{length_longest}, $arg->{length_longest}, $arg->{list}[$idx] if not $arg->{right_justify};
            $arg->{rowcol_to_list_index}[$idx][0] = $idx;
        }
    }
    else {
        # auto_format
	my $maxcls = $arg->{maxcols};
	if ( $arg->{layout} == 1 or $arg->{layout} == 2 ) {
            my $tmc = int( @{$arg->{list}} / $arg->{maxrows} );
	    $tmc++ if @{$arg->{list}} % $arg->{maxrows};
	    $tmc *= $arg->{col_width};
	    if ( $tmc < $maxcls ) {
		$tmc = int( $tmc + ( ( $maxcls - $tmc ) / ( $arg->{auto_format} + 1 ) ) ) if $arg->{layout} == 1;
		$maxcls = $tmc;
	    }
	}
        # end auto_format
    # end layout
    # row_first
        my $cols_per_row = int( $maxcls / $arg->{col_width} );
        my $rows = int( ( $#{$arg->{list}} + $cols_per_row ) / $cols_per_row );
        $arg->{rest} = @{$arg->{list}} % $cols_per_row;
        if ( $arg->{vertical_order} ) {
            my @rearranged_list;
            my @rearranged_idx;
            my $i = 0;
            my $idxs = [ 0 .. $#{$arg->{list}} ];
            for ( 0 .. $cols_per_row - 1 ) {
                $i = 1 if $arg->{rest} and $_ >= $arg->{rest};
                $rearranged_list[$_] = [ splice( @{$arg->{list}}, 0, $rows - $i ) ];
                $rearranged_idx[$_]  = [ splice( @{$idxs},        0, $rows - $i ) ]; 
            }
            for my $e ( 0 .. $rows - 1 ) {
                my @temp_new_list;
                my @temp_idx;
                for my $c ( 0 .. $cols_per_row - 1 ) {
                    next if $arg->{rest} and $e == $rows - 1 and $c >= $arg->{rest}; 
                    push @temp_new_list, sprintf "%*.*s",  $arg->{length_longest}, $arg->{length_longest}, $rearranged_list[$c][$e] if $arg->{right_justify};   # ----- # unicode_sprintf
                    push @temp_new_list, sprintf "%-*.*s", $arg->{length_longest}, $arg->{length_longest}, $rearranged_list[$c][$e] if not $arg->{right_justify};
                    push @temp_idx, $rearranged_idx[$c][$e];
                }
                push @{$arg->{new_list}}, \@temp_new_list;
                push @{$arg->{rowcol_to_list_index}}, \@temp_idx;
            }
        }
        else {
            my $begin = 0;
            my $end = $cols_per_row - 1;
            while (  my @rearranged_list = @{$arg->{list}}[$begin..$end]  ) {
                my @temp_new_list;
                for my $rearranged_list_item ( @rearranged_list ) {
                    push @temp_new_list, sprintf "%*.*s",  $arg->{length_longest}, $arg->{length_longest}, $rearranged_list_item if $arg->{right_justify};   # ----- # unicode_sprintf
                    push @temp_new_list, sprintf "%-*.*s", $arg->{length_longest}, $arg->{length_longest}, $rearranged_list_item if not $arg->{right_justify};
                }
                push @{$arg->{new_list}}, \@temp_new_list;
                push @{$arg->{rowcol_to_list_index}}, [ $begin .. $end ];
                $begin = $end + 1;
                $end = $begin + $cols_per_row - 1;
                $end = $#{$arg->{list}} if $end > $#{$arg->{list}};
            }      
        }
    }
}


sub _handle_mouse {
    my ( $x, $y, $button_pressed, $button_drag, $arg ) = @_;   
    return NEXT_getch if $button_drag;
    my $top_row = $arg->{abs_curs_Y}; # $arg->{abs_curs_Y} - $arg->{cursor_row_begin}; # history 
    if ( $button_pressed == 4 ) {
        return KEY_UP;
    }    
    elsif ( $button_pressed == 5 ) {
        return KEY_DOWN;
    }
#    if ( $arg->{LastEventWasPress} ) { 
#        $arg->{LastEventWasPress} = 0; 
#        return NEXT_getch;
#    }
    return NEXT_getch if not $y >= $top_row;
    my $mouse_row = $y - $top_row;
    my $mouse_col = $x;
    my( $found_row, $found_col );
    my $found = 0;
    for my $row ( 0 .. @{$arg->{new_list}} ) {
	if ( $row == $mouse_row ) {
            for my $col ( 0 .. $#{$arg->{new_list}[$row]} ) {
                if ( $col * $arg->{col_width} < $mouse_col and ( ( $col + 1 ) * $arg->{col_width} ) >= $mouse_col ) {
                    $found = 1; 
                    $found_row = $row + $arg->{page};
                    $found_col = $col;
                    last;
                }
            }
        }
    }
    return NEXT_getch if not $found;
    # if xterm doesn't receive a button-up event it thinks it's dragging # orig comment
    my $return_char = '';
    if ( $button_pressed == 1 ) {
        # $arg->{LastEventWasPress} = 1;
        $return_char = KEY_ENTER;
    } 
    elsif ( $button_pressed == 3  ) {
        # $arg->{LastEventWasPress} = 1;
        $return_char = KEY_SPACE;
    }
    else {
        return NEXT_getch; # xterm
    }
    if ( not [ $found_row, $found_col ] ~~ $arg->{this_cell} ) {
        if ( $found_row > $arg->{this_cell}[ROW] ) {
            $arg->{row_total} += $found_row - $arg->{this_cell}[ROW];
        }
        elsif ( $arg->{this_cell}[ROW] > $found_row ) {
            $arg->{row_total} -= $arg->{this_cell}[ROW] - $found_row;
        }
        my $t = $arg->{this_cell}; 
        $arg->{this_cell} = [ $found_row, $found_col ];
        _wr_cell( $arg, $t->[0], $t->[1] );
        _wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] ); 
    }
    return $return_char;
}


1;

__DATA__

=head1 NAME

Term::Choose - Choose items from a list.

=head1 VERSION

Version 0.07

=cut



=head1 SYNOPSIS

    use Term::Choose qw(choose);
    
    my $list = [ qw( one two three four five ) ];

    my @choices = choose( $list, { prompt => 'Choose:' } ); # multiple choice
    say "@choices";

    my $choice = choose( $list, { prompt => 'Choose:' } );  # single choice
    say $choice;



=head1 DESCRIPTION

I<choose> is similar to the I<choose> function from the Term::Clui module (which served as a model).

=head1 EXPORT

Nothing by default.

    use Term::Choose qw(choose);

=head1 SUBROUTINES/METHODS

=head2 choose

$scalar = choose( $list_ref [, \%options] ); 

@array =  choose( $list_ref [, \%options] );

If I<choose> is called in a scalar context, the user can choose an item using move-around-keys and C<Return>. I<choose> then returns the chosen item.
If the option C<extra_key> is enabled pressing C<q> returns "QUIT" and pressing C<b> returns "BACK".
If the option C<extra_key> is not enabled pressing C<q> returns C<undef> or an empty list in listcontext.

If I<choose> is called in an list context, the user can also mark an item with the c<SpaceBar>. I<choose> then returns the list of marked items, (including the item highlit when C<Return> was pressed).

Keys to move around: arrow keys (or hjkl), tab, backspace, shift-tab.


If there is no argument I<choose> returns C<undef> resp. an empty list and issues a warning.

If the first argument is not a array reference I<choose> returns  C<undef> resp. an empty list and issues a warning.

If the list referred by the first argument is empty I<choose> returns  C<undef> resp. an empty list and issues a warning.

If the list referred by the first argument has more then C<max_list> items (default 100_000) I<choose> returns  C<undef> resp. an empty list and issues a warning.

If an option doesn't exist I<choose> warns.

If an option value is not valid  I<choose> warns an falls back to the default value.

=head3 OPTIONS

All options are optional.

=over

=item prompt

I<string>

prompt-string

If prompt is undefined default prompt will be shown

If prompt is 0 no prompt-line will be shown

=item right_justify

I<0|1>

0 -> columns are left-justified (default)

1 -> columns are right-justified

=item layout

I<0|1|2|3>

0 -> no layout

1 -> if it fits in the screen: all in the first row - else: not used the whole width of the screen if not needed (default)

2 -> if fits in the screen: all in one column (first column) - else: not used the whole width of the screen if not needed

3 -> all in one (the first) column

=item vertical_order

I<0|1>

0 -> item ordered horizontally

1 -> item ordered vertically (default)

=item clear_screen

I<0|1>

0 -> default

1 -> clears the screen before printing the choices

=item mouse_mode

I<0|1|2|3|4>    

0 -> no mouse mode

1 -> mouse mode enabled (1003) (default)

2 -> mouse mode enabled; maxcols/maxrows limited to 224. Normal mouse mode (1003) doesn't work above 224.

3 -> extended mouse mode (1005) - uses utf8 - may not work

4 -> extended SGR (1006) mouse mode. If supported else normal mouse mode (1003)

=item pad

I<natural number (^[0-9]+$)>

space between items

=item pad_one_row

I<natural number (^[0-9]+$)>

space between items if we have only one row

=item extra_key

I<0|1>

0 -> off : pressing C<q> 
returns C<undef> or an empty list in listcontext

1 -> on (default): 
pressing key C<q> returns 'QUIT' 
pressing key C<b> returns 'BACK'


=item beep

I<0|1>

0 -> off

1 -> on

=item undef_element

I<string>

string displayed on the screen instead a undefined listelement. default C<\<undef\>>

=item empty_string

I<string>

string displayed on the screen instead an empty string. default C<\<empty\>>

=item max_list

I<natural number (^[1-9][0-9]*$)>

maximal allowed length of the list referred by the first argument (default 100_000 )

=back

=head1 BUGS

Please report any bugs

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Term::Choose


=head1 ACKNOWLEDGEMENTS


=head1 AUTHOR

Kürbis

=head1 LICENSE AND COPYRIGHT

Copyright 2012 Kürbis.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut

1; # End of Term::Choose