use warnings; use strict; use 5.14.0; use utf8; package Clui_sid; # Author: Kürbis our $VERSION = '0.3'; #our $VERSOIN = '2012.05.05'; use Exporter 'import'; our @EXPORT_OK = qw(aw help); use Scalar::Util qw(reftype); use Signals::XSIG; use Term::ReadKey; # ----- # use Log::Log4perl qw(get_logger); my $log = get_logger("Clui_sid"); use constant { ROW => 0, COL => 1, }; use constant { UP => "\e[A", DOWN => "\e[B", RIGHT => "\e[C", CR => "\r", GET_CURSOR_POSITION => "\e[6n", HIDE_CURSOR => "\e[?25h", SHOW_CURSOR => "\e[?25l", 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", BEEP => "\07", 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_a => 1, CONTROL_c => 3, CONTROL_e => 5, CONTROL_h => 8, KEY_TAB => 9, KEY_ENTER => 13, # CR KEY_ESC => 27, KEY_SPACE => 32, KEY_a => 97, KEY_b => 98, KEY_e => 101, KEY_h => 104, KEY_j => 106, KEY_k => 107, KEY_l => 108, KEY_q => 113, KEY_BSPACE => 127, KEY_UP => 279165, KEY_DOWN => 279166, KEY_RIGHT => 279167, KEY_LEFT => 279168, KEY_INSERT => 279150, KEY_DELETE => 279151, KEY_POS1 => 279172, KEY_END => 279170, KEY_PPAGE => 279153, KEY_NPAGE => 279154, KEY_BTAB => 279190, }; sub set_layout { my $config = shift // {}; $config->{prompt} //= 'Your choice:'; $config->{right_justify} //= 0; # true/false $config->{layout} //= 3; # 0,1,2,3 $config->{auto_format} //= 1; # true/false $config->{mouse_mode} //= 4; # 0,1,2,3,4 $config->{pad} //= 2; # \d+ $config->{pad_one_row} //= 1; # \d+ $config->{extra_key} //= 1; # 0/1 $config->{handle_out} //= \*STDOUT; $config->{is_interactive} //= 1; return $config; } $ENV{CLUI_MOUSE} = $ENV{CLUI_MOUSE} || ''; sub get_ch { 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 'H' ) { return KEY_POS1; } elsif ( $c eq 'F' ) { return KEY_END; } elsif ( $c eq 'Z' ) { return KEY_BTAB; } elsif ( $c eq '5' ) { return KEY_PPAGE; } elsif ( $c eq '6' ) { return KEY_NPAGE; } 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 'H' ) { return KEY_POS1; } elsif ( $c eq 'F' ) { return KEY_END; } elsif ( $c eq 'Z' ) { return KEY_BTAB; } elsif ( $c eq '5' ) { return KEY_PPAGE; } elsif ( $c eq '6' ) { return KEY_NPAGE; } 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 ); } if ( $c =~ /\A\d/ ) { my $c1 = ReadKey 0; if ( $c1 eq '~' ) { # if ( $c eq '2' ) { return KEY_INSERT; } # if ( $c eq '3' ) { return KEY_DELETE; } if ( $c eq '5' ) { return KEY_PPAGE; } if ( $c eq '6' ) { return KEY_NPAGE; } } else { # cursor-position report, response to \e[6n $arg->{AbsCursY} = 0 + $c; while ( 1 ) { last if $c1 eq ';'; $arg->{AbsCursY} = 10 * $arg->{AbsCursY} + $c1; $c1 = ReadKey 0; } $arg->{AbsCursX} = 0; while ( 1 ) { $c1 = ReadKey 0; last if $c1 eq 'R'; $arg->{AbsCursX} = 10 * $arg->{AbsCursX} + $c1; } 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->{zeile} + $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 ( $arg ) = @_; # ----- # my $longest = length $arg->{list}[0]; for my $str ( @{$arg->{list}} ) { # ----- # if ( length $str > $longest ) { $longest = length $str; } } return $longest; } sub write_first_screen { my ( $arg ) = @_; ( $arg->{maxcols}, $arg->{maxrows} ) = GetTerminalSize( $arg->{handle_out} ); $arg->{maxcols}--; if ( $arg->{mouse_mode} == 2 ) { $arg->{maxcols} = 223 if $arg->{maxcols} > 223; $arg->{maxrows} = 223 if $arg->{maxrows} > 223; } $arg->{head} = 0; go_to( $arg, $arg->{head}, 0 ); clear_to_end_of_screen( $arg ); if ( $arg->{prompt} ne '0' ) { my $firstline = $arg->{prompt}; # ----- # if ( $arg->{wantarray} ) { $firstline = $arg->{prompt} . ' (multiple choice with spacebar)'; $firstline = $arg->{prompt} . ' (multiple choice)' if length $firstline > $arg->{maxcols}; } if ( length $firstline > $arg->{maxcols} ) { # ----- # $firstline = substr( $arg->{prompt}, 0, $arg->{maxcols} ); } print $firstline; $arg->{head}++; } $arg->{maxrows} -= $arg->{head}; $arg->{marked} = []; $arg = 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->{zeile} ) = ( 0, 0 ); wr_screen( $arg ); print GET_CURSOR_POSITION; # in: $arg->{AbsCursX}, $arg->{AbsCursY} # $arg->{cursor_row_begin} = $arg->{this_cell}[ROW]; # history ? $arg->{size_changed} = 0; return $arg; } sub aw { my ( $orig_list, $config ) = @_; if ( not defined $orig_list ) { warn "No Argument!"; return; } elsif ( not reftype( $orig_list ) ) { warn "List has to be a Reference"; return; } elsif ( not reftype( $orig_list ) eq 'ARRAY' ) { warn "List Argument has to be a Array Reference!"; return; } elsif ( not @$orig_list ) { warn "List is empty!"; return; } my $arg = set_layout( $config ); $arg->{orig_list} = $orig_list; $arg->{handle_out} = ( $arg->{is_interactive} ) ? \*STDOUT : \*STDERR; binmode $arg->{handle_out}, ':encoding(utf-8)'; $arg->{list} = [ map{ s/\n+$//; s/\t/ /g; $_ } @{$arg->{orig_list}} ]; # if element is not defined? $arg->{ll} = length_longest( $arg ); $arg->{length} = $arg->{ll} + $arg->{pad}; $arg->{wantarray} = wantarray ? 1 : 0; $arg->{LastEventWasPress} = 0; # in order to ignore left-over button-ups # orig comment Term::Clui $arg->{AbsCursX} = 0; $arg->{AbsCursY} = 0; $arg->{irow} = 0; $arg->{this_cell} = []; init_scr( $arg ); $arg = write_first_screen( $arg ); $XSIG{WINCH}[5] = sub { $arg->{size_changed} = 1; }; while ( 1 ) { my $c = get_ch( $arg ); next if $c == NEXT_getch; if ( $arg->{size_changed} ) { $arg->{list} = [ map{ s/\n+$//; s/\t/ /g; $_ } @{$arg->{orig_list}} ]; # if element is not defined? $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]] ) ) { my_beep( $arg ); } else { $arg->{zeile}++; 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->{zeile}; $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 ) { my_beep( $arg ); } else { $arg->{zeile}--; 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->{zeile} - $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}} ) { my_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->{zeile}++; 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->{zeile}; $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 == CONTROL_h or $c == KEY_BTAB ) and ( $arg->{this_cell} > 0 ) ) { if ( $arg->{this_cell}[COL] == 0 and $arg->{this_cell}[ROW] == 0 ) { my_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->{zeile}--; 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->{zeile} - $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]]} ) { my_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 ) { my_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 { my_beep( $arg ); } } when ( $c == KEY_q ) { end_win( $arg ); return 'QUIT' if $arg->{extra_key}; return; } when ( $c == CONTROL_c ) { end_win( $arg ); warn "^C\n"; 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->{orig_idx}[$row][$col]; $i //= $row; # $layout push @chosen, $arg->{orig_list}[$i]; } } } return @chosen; } else { my $i = $arg->{orig_idx}[$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] ); } } when ( $c == KEY_e or $c == KEY_END ) { # when ( $c == CONTROL_e ) { my $l_row = $#{$arg->{new_list}}; $l_row-- if $arg->{rest}; while ( $arg->{zeile} < $l_row ) { $arg->{zeile}++; if ( $arg->{this_cell}[ROW] + 1 <= $arg->{end_page} ) { $arg->{this_cell}[ROW]++; } else { $arg->{page} = $arg->{zeile}; $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] = $#{$arg->{new_list}[$l_row]}; wr_screen( $arg ); wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] ); } when ( $c == KEY_a or $c == KEY_POS1 ) { # when ( $c == CONTROL_a ) { while ( $arg->{zeile} > 0 ) { $arg->{zeile}--; if ( $arg->{this_cell}[ROW] - 1 >= $arg->{begin_page} ) { $arg->{this_cell}[ROW]--; } else { $arg->{begin_page}--; $arg->{page} = $arg->{zeile} - $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]--; } } $arg->{this_cell}[COL] = 0; wr_screen( $arg ); wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] ); } when ( $c == KEY_NPAGE ) { my $l_row = $arg->{zeile}; $l_row++; if ( $l_row + $arg->{available} > $#{$arg->{new_list}} ) { $l_row = $#{$arg->{new_list}}; $l_row-- if $arg->{rest} and $arg->{this_cell}[COL] >= $arg->{rest}; } else { $l_row += $arg->{available}; } while ( $arg->{zeile} < $l_row ) { $arg->{zeile}++; if ( $arg->{this_cell}[ROW] + 1 <= $arg->{end_page} ) { $arg->{this_cell}[ROW]++; } else { $arg->{page} = $arg->{zeile}; $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 ); wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] ); } when ( $c == KEY_PPAGE ) { my $f_row = $arg->{zeile} - ( $arg->{end_page} - $arg->{begin_page} ) - 1; $f_row++ if $arg->{end_page} == $#{$arg->{new_list}} and $arg->{rest} and $arg->{this_cell}[COL] >= $arg->{rest}; $f_row = 0 if $f_row < 0; while ( $arg->{zeile} > $f_row ) { $arg->{zeile}--; if ( $arg->{this_cell}[ROW] - 1 >= $arg->{begin_page} ) { $arg->{this_cell}[ROW]--; } else { $arg->{begin_page}--; $arg->{page} = $arg->{zeile} - $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 ); wr_cell( $arg, $arg->{this_cell}[ROW], $arg->{this_cell}[COL] ); } # default { # my_beep( $arg ); # } } } end_win( $arg ); warn "aw: shouldn't reach here ...\n"; } sub my_beep { my ( $arg ) = @_; print BEEP; } sub clear_to_end_of_screen { my ( $arg ) = @_; print CLEAR_EOS; } sub go_to { 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 ) = @_; go_to( $arg, $arg->{head}, 0 ); clear_to_end_of_screen( $arg ); my $join = ' ' x $arg->{pad}; $join .= ' ' x $arg->{pad_one_row} if $arg->{all_in_first_row}; my $screen; for my $row ( $arg->{begin_page} .. $arg->{end_page} ) { $screen .= join( $join, @{$arg->{new_list}[$row]}[ 0 .. $#{$arg->{new_list}[$row]} ] ) . "\r\n"; $arg->{irow}++; } print $screen =~ s/\r\n\z//r; $arg->{irow}--; 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} // 0; $lngth += $arg->{pad_one_row} // 0; } } go_to( $arg, $row + $arg->{head} - $arg->{page}, $lngth ); } else { go_to( $arg, $row + $arg->{head} - $arg->{page}, $col * $arg->{length} ); } print BOLD, UNDERLINE if $arg->{marked}[$row][$col]; print REVERSE if [ $row, $col ] ~~ $arg->{this_cell}; print $arg->{new_list}[$row][$col]; # if " $arg->{new_list}[$row][$col] " -> layout: if ( $arg->{ll} > $arg->{maxcols} - 2 ) { $arg->{ll} = $arg->{maxcols} - 2; 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->{orig_idx} = []; $arg->{all_in_first_row} = 0; if ( $arg->{ll} > $arg->{maxcols} ) { $arg->{ll} = $arg->{maxcols}; $layout = 1; } ##### layout ##### $arg->{this_cell} = [ 0, 0 ]; my $all_in_first_row; if ( not $layout == 1 ) { if ( $layout == 2 ) { $layout = 1 if scalar @{$arg->{list}} <= $arg->{maxrows}; } else { for my $element ( 0 .. $#{$arg->{list}} ) { $all_in_first_row .= $arg->{list}[$element]; $all_in_first_row .= ' ' x ( $arg->{pad} + $arg->{pad_one_row} ); # ----- # if ( length $all_in_first_row > $arg->{maxcols} ) { $all_in_first_row = ''; if ( $layout >= 2 ) { $layout = 1 if scalar @{$arg->{list}} <= $arg->{maxrows}; } last; } } } } if ( $all_in_first_row ) { $arg->{all_in_first_row} = 1; $arg->{new_list}[0] = [ @{$arg->{list}} ]; @{$arg->{orig_idx}[0]}[ 0..$#{$arg->{list}} ] = 0 .. $#{$arg->{list}}; } elsif ( $layout == 1 ) { for my $idx ( 0 .. $#{$arg->{list}} ) { # ----- # if ( length $arg->{list}[$idx] > $arg->{ll} ) { $arg->{list}[$idx] = substr( $arg->{list}[$idx], 0, $arg->{ll} - 3 ) . '...'; } $arg->{new_list}[$idx][0] = sprintf "%*.*s", $arg->{ll}, $arg->{ll}, $arg->{list}[$idx] if $arg->{right_justify}; $arg->{new_list}[$idx][0] = sprintf "%-*.*s", $arg->{ll}, $arg->{ll}, $arg->{list}[$idx] if not $arg->{right_justify}; $arg->{orig_idx}[$idx][0] = $idx; } } else { # auto_format #### my $maxcls = $arg->{maxcols}; if ( $arg->{auto_format} ) { my $tmc = int( @{$arg->{list}} / $arg->{maxrows} ); $tmc++ if @{$arg->{list}} % $arg->{maxrows}; $tmc++; $tmc *= $arg->{length}; if ( $tmc < $maxcls ) { $tmc = int( $tmc + ( ( ( $maxcls - $tmc ) / 2 ) * 1 ) ); $maxcls = $tmc; } } # ende auto_format #### ##### ende layout ##### ##### row_first ##### my $cols_perl_row = int( $maxcls / $arg->{length} ); my $rows = int( ( $#{$arg->{list}} + $cols_perl_row ) / $cols_perl_row ); $arg->{rest} = @{$arg->{list}} % $cols_perl_row; my @arr_list; my @arr_idx; my $i = 0; my $idxs = [ 0 .. $#{$arg->{list}} ]; for ( 0 .. $cols_perl_row - 1 ) { $i = 1 if $arg->{rest} and $_ >= $arg->{rest}; $arr_list[$_] = [ splice( @{$arg->{list}}, 0, $rows - $i ) ]; $arr_idx[$_] = [ splice( @$idxs, 0, $rows - $i ) ]; } for my $e ( 0 .. $rows - 1 ) { my @temp_list; my @temp_idx; for my $c ( 0 .. $cols_perl_row - 1 ) { next if $arg->{rest} and $e == $rows - 1 and $c >= $arg->{rest}; push @temp_list, sprintf "%*.*s", $arg->{ll}, $arg->{ll}, $arr_list[$c][$e] if $arg->{right_justify}; push @temp_list, sprintf "%-*.*s", $arg->{ll}, $arg->{ll}, $arr_list[$c][$e] if not $arg->{right_justify}; push @temp_idx, $arr_idx[$c][$e]; } push @{$arg->{new_list}}, \@temp_list; push @{$arg->{orig_idx}}, \@temp_idx; } } return $arg; } sub handle_mouse { my ( $x, $y, $button_pressed, $button_drag, $arg ) = @_; # my $top_row = $arg->{AbsCursY} - $arg->{cursor_row_begin}; # history ? my $top_row = $arg->{AbsCursY}; 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->{length} < $mouse_col and ( ( $col + 1 ) * $arg->{length} ) >= $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 Term::Clui my $return_char = ''; if ( $button_pressed == 1 and not $button_drag ) { $arg->{LastEventWasPress} = 1; $return_char = KEY_ENTER; } elsif ( $button_pressed == 3 and not $button_drag ) { $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->{zeile} += $found_row - $arg->{this_cell}[ROW]; } elsif ( $arg->{this_cell}[ROW] > $found_row ) { $arg->{zeile} -= $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; } sub help { my $help = < prompt-string if prompt is undefined default prompt will be shown if prompt is 0 no prompt-line will be shown ------------------------------------------------------------------------------------------------------------------- is_interactive=> 0 -> standard-out goes to \*STDERR 1 -> standard-out goes to \*STDOUT (default) ------------------------------------------------------------------------------------------------------------------- right_justify => 0 -> columns are left-justified (default) 1 -> columns are right-justified ------------------------------------------------------------------------------------------------------------------- layout => 0 -> normal 1 -> all in one (the first) column 2 -> if possible all in one column (first column) else normal 3 -> if possible all in one row (first row) else if possible all in one column (first column) else normal (default) ------------------------------------------------------------------------------------------------------------------- auto_format => 0 -> off 1 -> on (default) if on: not used the whole width of the screen if not needed ------------------------------------------------------------------------------------------------------------------- mouse_mode => 0 -> no mouse mode (mouse doesn't work) 1 -> mouse mode enabled (1003) 2 -> mouse mode enabled; maxcols/maxrows limited to 223 (normal mouse mode doesn't work above 223) 3 -> extended mouse mode (1005) - uses utf8 - may not work 4 -> extended SGR (1006) mouse mode (default). If supported else normal mouse mode (1003) ------------------------------------------------------------------------------------------------------------------- pad => number (integer: \\d+) - space between items ------------------------------------------------------------------------------------------------------------------- pad_one_row => number (integer: \\d+) - additional (to pad) space between items if we have only one row ------------------------------------------------------------------------------------------------------------------- extra_key => 0 -> off presiing key 'q' returns undef 1 -> on (default) if on: pressing key 'q' returns 'QUIT' pressing key 'b' returns 'BACK' ------------------------------------------------------------------------------------------------------------------- EOH say $help; } 1; __DATA__