File Coverage

blib/lib/Term/Choose.pm
Criterion Covered Total %
statement 45 933 4.8
branch 8 554 1.4
condition 0 229 0.0
subroutine 14 40 35.0
pod 2 2 100.0
total 69 1758 3.9


line stmt bran cond sub pod time code
1             package Term::Choose;
2              
3 3     3   390872 use warnings;
  3         8  
  3         226  
4 3     3   35 use strict;
  3         7  
  3         97  
5 3     3   60 use 5.10.1;
  3         12  
6              
7             our $VERSION = '1.781';
8 3     3   20 use Exporter 'import';
  3         20  
  3         207  
9             our @EXPORT_OK = qw( choose );
10              
11 3     3   19 use Carp qw( croak carp );
  3         15  
  3         289  
12              
13 3     3   1787 use Term::Choose::Constants qw( :all );
  3         10  
  3         1161  
14 3     3   1846 use Term::Choose::LineFold qw( line_fold print_columns cut_to_printwidth );
  3         10  
  3         440  
15 3     3   22 use Term::Choose::Screen qw( :all );
  3         5  
  3         843  
16 3     3   1587 use Term::Choose::ValidateOptions qw( validate_options );
  3         9  
  3         463  
17              
18             my $Plugin;
19              
20             BEGIN {
21 3 50   3   21 if ( $^O eq 'MSWin32' ) {
22 0         0 require Win32::Console::ANSI;
23 0         0 require Term::Choose::Win32;
24 0         0 $Plugin = 'Term::Choose::Win32';
25             }
26             else {
27 3         1588 require Term::Choose::Linux;
28 3         42075 $Plugin = 'Term::Choose::Linux';
29             }
30             }
31              
32             END {
33 3 50   3   155385 if ( $? == 255 ) {
34 0 0       0 if( $^O eq 'MSWin32' ) {
    0          
35 0         0 my $input = Win32::Console->new( Win32::Console::constant( "STD_INPUT_HANDLE", 0 ) );
36 0         0 $input->Mode( 0x0001|0x0002|0x0004 );
37 0         0 $input->Flush;
38             }
39             elsif ( TERM_READKEY ) {
40 0         0 Term::ReadKey::ReadMode( 'restore' );
41             }
42             else {
43 0         0 system( "stty sane" );
44             }
45 0         0 print "\n", clear_to_end_of_screen;
46 0         0 print show_cursor;
47             }
48             }
49              
50              
51             sub new {
52 113     113 1 484795 my $class = shift;
53 113         266 my ( $opt ) = @_;
54 113 50       397 croak "new: called with " . @_ . " arguments - 0 or 1 arguments expected" if @_ > 1;
55 113         290 my $instance_defaults = _defaults();
56 113 100       329 if ( defined $opt ) {
57 111 50       347 croak "new: the (optional) argument must be a HASH reference" if ref $opt ne 'HASH';
58 111         295 validate_options( _valid_options(), $opt, 'new' );
59 111         800 for my $key ( keys %$opt ) {
60 150 100       515 $instance_defaults->{$key} = $opt->{$key} if defined $opt->{$key};
61             }
62             }
63 113         271 my $self = bless $instance_defaults, $class;
64 113         993 $self->{backup_instance_defaults} = { %$instance_defaults };
65 113         553 $self->{plugin} = $Plugin->new();
66 113         651 return $self;
67             }
68              
69              
70             sub _valid_options {
71             return {
72 111     111   2609 beep => '[ 0 1 ]',
73             clear_screen => '[ 0 1 ]',
74             codepage_mapping => '[ 0 1 ]',
75             hide_cursor => '[ 0 1 ]',
76             index => '[ 0 1 ]',
77             mouse => '[ 0 1 ]',
78             order => '[ 0 1 ]',
79             alignment => '[ 0 1 2 ]',
80             color => '[ 0 1 2 ]',
81             include_highlighted => '[ 0 1 2 ]',
82             layout => '[ 0 1 2 ]',
83             page => '[ 0 1 2 ]',
84             search => '[ 0 1 2 ]',
85             keep => '[ 1-9 ][ 0-9 ]*',
86             ll => '[ 1-9 ][ 0-9 ]*',
87             max_cols => '[ 1-9 ][ 0-9 ]*',
88             max_height => '(?:[2-9]|[ 1-9 ][ 0-9 ]+)',
89             max_width => '(?:[2-9]|[ 1-9 ][ 0-9 ]+)',
90             default => '[ 0-9 ]+',
91             pad => '[ 0-9 ]+',
92             margin => 'Array_Int',
93             mark => 'Array_Int',
94             meta_items => 'Array_Int',
95             no_spacebar => 'Array_Int',
96             tabs_bottom_text => 'Array_Int',
97             tabs_info => 'Array_Int',
98             tabs_prompt => 'Array_Int',
99             skip_items => 'Regexp',
100             bottom_text => 'Str',
101             empty => 'Str',
102             footer => 'Str',
103             info => 'Str',
104             prompt => 'Str',
105             undef => 'Str',
106             busy_string => 'Str',
107             };
108             };
109              
110              
111             sub _defaults {
112             return {
113 113     113   1108 alignment => 0,
114             beep => 0,
115             #bottom_text => undef,
116             clear_screen => 0,
117             codepage_mapping => 0,
118             color => 0,
119             #default => undef,
120             empty => '',
121             #footer => undef,
122             hide_cursor => 1,
123             include_highlighted => 0,
124             index => 0,
125             #info => undef,
126             keep => 5,
127             layout => 1,
128             #ll => undef,
129             #margin => undef,
130             #mark => undef,
131             #max_cols => undef,
132             #max_height => undef,
133             #max_width => undef,
134             #meta_items => undef,
135             mouse => 0,
136             #no_spacebar => undef,
137             order => 1, ##
138             pad => 2,
139             page => 1,
140             #prompt => undef,
141             search => 1,
142             #skip_items => undef,
143             #tabs_bottom_text => undef,
144             #tabs_info => undef,
145             #tabs_prompt => undef,
146             undef => '',
147             #busy_string => undef,
148             };
149             }
150              
151              
152             sub __copy_orig_list {
153 0     0     my ( $self, $orig_list_ref ) = @_;
154 0 0         if ( $self->{ll} ) {
155 0           $self->{list} = $orig_list_ref;
156             }
157             else {
158 0           $self->{list} = [ @$orig_list_ref ];
159 0 0         if ( $self->{color} ) {
160 0           $self->{orig_list} = $orig_list_ref;
161             }
162 0           for ( @{$self->{list}} ) {
  0            
163 0 0         if ( ! $_ ) {
164 0 0         $_ = $self->{undef} if ! defined $_;
165 0 0         $_ = $self->{empty} if ! length $_;
166             }
167 0 0         if ( $self->{color} ) {
168 0           s/${\PH}//g;
  0            
169 0           s/${\SGR_ES}/${\PH}/g;
  0            
  0            
170             }
171 0           s/\t/ /g;
172 0           s/\v+/\ \ /g;
173             # \p{Cn} might not be up to date and remove assigned codepoints
174             # therefore only \p{Noncharacter_Code_Point}
175 0           s/[\p{Cc}\p{Noncharacter_Code_Point}\p{Cs}]//g;
176             }
177             }
178             }
179              
180              
181             sub __length_list_elements {
182 0     0     my ( $self ) = @_;
183 0           my $list = $self->{list};
184 0 0         if ( $self->{ll} ) {
185 0           $self->{col_width} = $self->{ll};
186             }
187             else {
188 0           my $length_elements = [];
189 0           my $longest = 0;
190 0           for my $i ( 0 .. $#$list ) {
191 0           $length_elements->[$i] = print_columns( $list->[$i] );
192 0 0         $longest = $length_elements->[$i] if $length_elements->[$i] > $longest;
193             }
194 0           $self->{width_elements} = $length_elements;
195 0           $self->{col_width} = $longest;
196             }
197 0           $self->{bu_col_width} = $self->{col_width};
198             }
199              
200              
201             sub __init_term {
202 0     0     my ( $self ) = @_;
203             my $config = {
204             mode => 'ultra-raw',
205             mouse => $self->{mouse},
206             hide_cursor => $self->{hide_cursor},
207 0           };
208 0           $self->{mouse} = $self->{plugin}->__set_mode( $config );
209             }
210              
211              
212             sub __reset_term {
213 0     0     my ( $self, $clear_choose ) = @_;
214 0 0         if ( defined $self->{plugin} ) {
215 0           $self->{plugin}->__reset_mode( { mouse => $self->{mouse}, hide_cursor => $self->{hide_cursor} } );
216             }
217 0 0         if ( $clear_choose ) {
218 0           my $up = $self->{i_row} + $self->{count_pre_rows};
219 0 0         print up( $up ) if $up;
220 0           print "\r" . clear_to_end_of_screen();
221             }
222 0 0         if ( exists $self->{backup_instance_defaults} ) { # backup_instance_defaults exists if ObjectOriented
223 0           my $instance_defaults = $self->{backup_instance_defaults};
224 0           for my $key ( keys %$self ) {
225 0 0 0       if ( $key eq 'plugin' || $key eq 'backup_instance_defaults' ) {
    0          
226 0           next;
227             }
228             elsif ( exists $instance_defaults->{$key} ) {
229 0           $self->{$key} = $instance_defaults->{$key};
230             }
231             else {
232 0           delete $self->{$key};
233             }
234             }
235             }
236             }
237              
238              
239             sub __invalid_term_size {
240 0     0     my ( $self, $term_width, $term_height, $clear_choose ) = @_;
241 0           $self->__reset_term( $clear_choose );
242 0 0         die "Undefined term width." if ! defined $term_width;
243 0 0         die "Undefined term height." if ! defined $term_height;
244 0           exit;
245             }
246              
247              
248             sub __get_key {
249 0     0     my ( $self ) = @_;
250 0           my $key;
251 0 0         if ( defined $self->{skip_items} ) {
252 0           my $idx = $self->{rc2idx}[$self->{pos}[ROW]][$self->{pos}[COL]];
253 0 0         if ( $self->{list}[$idx] =~ $self->{skip_items} ) {
254 0           $key = $self->Term::Choose::Opt::SkipItems::__key_skipped();
255             }
256             }
257 0 0         if ( ! defined $key ) {
258 0           $key = $self->{plugin}->__get_key_OS( $self->{mouse} );
259             }
260 0 0         return $key if ref $key ne 'ARRAY';
261 0           return $self->Term::Choose::Opt::Mouse::__mouse_info_to_key( @$key );
262             }
263              
264              
265             sub __modify_options {
266 0     0     my ( $self ) = @_;
267 0 0 0       if ( defined $self->{max_cols} && $self->{max_cols} == 1 ) {
268 0           $self->{layout} = 2;
269             }
270 0 0 0       if ( $self->{max_height} && $self->{max_height} < $self->{keep} ) {
271 0           $self->{keep} = $self->{max_height}; ##
272             }
273 0 0 0       if ( length $self->{footer} && $self->{page} != 2 ) {
274 0           $self->{page} = 2;
275             }
276 0 0 0       if ( $self->{page} == 2 && ! $self->{clear_screen} ) {
277 0           $self->{clear_screen} = 1;
278             }
279 0 0 0       if ( $self->{max_cols} && $self->{layout} == 1 ) {
280 0           $self->{layout} = 0;
281             }
282 0 0         if ( ! defined $self->{prompt} ) {
283 0 0         $self->{prompt} = defined $self->{wantarray} ? 'Your choice:' : 'Close with ENTER';
284             }
285 0 0         if ( defined $self->{margin} ) {
286 0           ( $self->{margin_top}, $self->{margin_right}, $self->{margin_bottom}, $self->{margin_left} ) = @{$self->{margin}};
  0            
287 0 0         if ( ! defined $self->{tabs_prompt} ) {
288 0           $self->{tabs_prompt} = [ $self->{margin_left}, $self->{margin_left}, $self->{margin_right} ];
289             }
290 0 0         if ( ! defined $self->{tabs_info} ) {
291 0           $self->{tabs_info} = [ $self->{margin_left}, $self->{margin_left}, $self->{margin_right} ];
292             }
293 0 0         if ( ! defined $self->{tabs_bottom_text} ) {
294 0           $self->{tabs_bottom_text} = [ $self->{margin_left}, $self->{margin_left}, $self->{margin_right} ];
295             }
296             }
297             }
298              
299              
300             sub choose {
301 0 0   0 1   if ( ref $_[0] ne __PACKAGE__ ) {
302 0           my $ob = __PACKAGE__->new();
303 0           delete $ob->{backup_instance_defaults};
304 0           return $ob->__choose( @_ );
305             }
306 0           my $self = shift;
307 0           return $self->__choose( @_ );
308             }
309              
310              
311             sub __choose {
312 0     0     my $self = shift;
313 0           my ( $orig_list_ref, $opt ) = @_;
314 0 0 0       croak "choose: called with " . @_ . " arguments - 1 or 2 arguments expected" if @_ < 1 || @_ > 2;
315 0 0         croak "choose: the first argument must be an ARRAY reference" if ref $orig_list_ref ne 'ARRAY';
316 0 0         if ( defined $opt ) {
317 0 0         croak "choose: the (optional) second argument must be a HASH reference" if ref $opt ne 'HASH';
318 0           validate_options( _valid_options(), $opt, 'choose' );
319 0           for my $key ( keys %$opt ) {
320 0 0         $self->{$key} = $opt->{$key} if defined $opt->{$key};
321             }
322             }
323 0 0         if ( ! @$orig_list_ref ) {
324 0           return;
325             }
326 0           local $\ = undef;
327 0           local $, = undef;
328 0           local $| = 1;
329 0 0         if ( defined $self->{busy_string} ) {
330 0           print "\r" . clear_to_end_of_line();
331 0           print $self->{busy_string};
332             }
333 0           $self->{wantarray} = wantarray;
334 0           $self->__modify_options();
335 0 0         if ( $self->{mouse} ) {
336 0           require Term::Choose::Opt::Mouse;
337             }
338 0 0         if ( $^O eq 'MSWin32' ) {
339 0 0         print $opt->{codepage_mapping} ? "\e(K" : "\e(U";
340             }
341 0           $self->__copy_orig_list( $orig_list_ref );
342 0           $self->__length_list_elements();
343 0 0         if ( defined $self->{skip_items} ) {
344 0           require Term::Choose::Opt::SkipItems;
345 0           $self->Term::Choose::Opt::SkipItems::__prepare_default();
346             }
347 0 0         if ( exists $ENV{TC_RESET_AUTO_UP} ) {
348 0           $ENV{TC_RESET_AUTO_UP} = 0;
349             }
350             local $SIG{INT} = sub {
351 0     0     $self->__reset_term();
352 0           exit;
353 0           };
354 0           $self->__init_term();
355 0           ( $self->{term_width}, $self->{term_height} ) = get_term_size();
356 0 0 0       if ( ( $self->{term_width} // 0 ) < 2 || ( $self->{term_height} // 0 ) < 2 ) {
      0        
      0        
357 0           $self->__invalid_term_size( $self->{term_width}, $self->{term_height}, 0 );
358             }
359 0           $self->__wr_first_screen();
360 0           my $fast_page = 10;
361 0 0         if ( $self->{pp_count} > 10_000 ) {
362 0           $fast_page = 20;
363             }
364 0           my $saved_pos;
365              
366 0           GET_KEY: while ( 1 ) {
367 0           my $key = $self->__get_key();
368 0 0         if ( ! defined $key ) {
369 0           $self->__reset_term( 1 );
370 0           carp "EOT: $!";
371 0           return;
372             }
373 0           $self->{pressed_key} = $key;
374 0           my ( $new_width, $new_height ) = get_term_size();
375 0 0 0       if ( ( $new_width // 0 ) < 2 || ( $new_height // 0 ) < 2 ) {
      0        
      0        
376 0           $self->__invalid_term_size( $new_width, $new_height, 1 );
377             }
378 0 0 0       if ( $new_width != $self->{term_width} || $new_height != $self->{term_height} ) {
379 0 0         if ( $self->{ll} ) {
380 0           $self->__reset_term( 0 );
381 0           return -1;
382             }
383 0 0         if ( $new_width < $self->{term_width} ) {
384 0   0       my $up = $self->{i_row} + ( $self->{margin_top} // 0 );
385 0           for my $opt ( qw( info prompt ) ) {
386 0 0         next if ! $self->{$opt};
387 0           for my $row ( @{$self->{$opt . '_rows'}} ) {
  0            
388 0 0 0       $up++ and next if ! length $row;
389 0 0         $row =~ s/${\SGR_ES}//g if $self->{color}; # __modify_options() resets the rows
  0            
390 0           my $w = print_columns( $row );
391 0           $up += int( $w / ( $new_width + EXTRA_W ) );
392 0 0         $up++ if $w % ( $new_width + EXTRA_W );
393             }
394             }
395 0 0         $up++ if length $self->{search_info};
396 0           $self->{count_pre_rows} = $up;
397             }
398              
399 0           ( $self->{term_width}, $self->{term_height} ) = ( $new_width, $new_height );
400 0           $self->{col_width} = $self->{bu_col_width};
401 0           $self->__modify_options();
402 0           $self->{default} = $self->{rc2idx}[$self->{pos}[ROW]][$self->{pos}[COL]];
403 0 0 0       if ( $self->{wantarray} && @{$self->{marked}} ) {
  0            
404 0           $self->{mark} = $self->__marked_rc2idx();
405             }
406 0           my $up = $self->{i_row} + $self->{count_pre_rows};
407 0 0         if ( $up ) {
408 0           print up( $up );
409             }
410             # print "\r" . clear_to_end_of_screen();
411 0           $self->__wr_first_screen();
412 0           next GET_KEY;
413             }
414 0 0         next GET_KEY if $key == NEXT_get_key;
415 0 0         next GET_KEY if $key == KEY_Tilde;
416 0 0 0       if ( exists $ENV{TC_RESET_AUTO_UP} && $ENV{TC_RESET_AUTO_UP} == 0 ) {
417 0 0 0       if ( $key != LINE_FEED && $key != CARRIAGE_RETURN ) {
418 0           $ENV{TC_RESET_AUTO_UP} = 1;
419             }
420             }
421 0           my $page_step = 1;
422 0 0         if ( $key == VK_INSERT ) {
    0          
423 0 0         $page_step = $fast_page if $self->{first_page_row} - $fast_page * $self->{avail_height} >= 0;
424 0           $key = VK_PAGE_UP;
425             }
426             elsif ( $key == VK_DELETE ) {
427 0 0         $page_step = $fast_page if $self->{last_page_row} + $fast_page * $self->{avail_height} <= $#{$self->{rc2idx}};
  0            
428 0           $key = VK_PAGE_DOWN;
429             }
430 0 0 0       if ( $saved_pos && $key != VK_PAGE_UP && $key != CONTROL_B && $key != VK_PAGE_DOWN && $key != CONTROL_F ) {
      0        
      0        
      0        
431 0           $saved_pos = undef;
432             }
433             # $self->{rc2idx} holds the new list (AoA) formatted in "__list_idx2rc" appropriate to the chosen layout.
434             # $self->{rc2idx} does not hold the values directly but the respective list indexes from the original list.
435             # If the original list would be ( 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h' ) and the new formatted list should be
436             # a d g
437             # b e h
438             # c f
439             # then the $self->{rc2idx} would look like this
440             # 0 3 6
441             # 1 4 7
442             # 2 5
443             # So e.g. the second value in the second row of the new list would be $self->{list}[ $self->{rc2idx}[1][1] ].
444             # On the other hand the index of the last row of the new list would be $#{$self->{rc2idx}}
445             # or the index of the last column in the first row would be $#{$self->{rc2idx}[0]}.
446              
447 0 0 0       if ( $key == VK_DOWN || $key == KEY_j ) {
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0          
    0          
448 0 0 0       if ( ! $self->{rc2idx}[$self->{pos}[ROW]+1]
449             || ! $self->{rc2idx}[$self->{pos}[ROW]+1][$self->{pos}[COL]]
450             ) {
451 0           $self->__beep();
452             }
453             else {
454 0           $self->{pos}[ROW]++;
455 0 0         if ( $self->{pos}[ROW] <= $self->{last_page_row} ) {
456 0           $self->__wr_cell( $self->{pos}[ROW] - 1, $self->{pos}[COL] );
457 0           $self->__wr_cell( $self->{pos}[ROW] , $self->{pos}[COL] );
458             }
459             else {
460 0           $self->{first_page_row} = $self->{last_page_row} + 1;
461 0           $self->{last_page_row} = $self->{last_page_row} + $self->{avail_height};
462 0 0         $self->{last_page_row} = $#{$self->{rc2idx}} if $self->{last_page_row} > $#{$self->{rc2idx}};
  0            
  0            
463 0           $self->__wr_screen();
464             }
465             }
466             }
467             elsif ( $key == VK_UP || $key == KEY_k ) {
468 0 0         if ( $self->{pos}[ROW] == 0 ) {
469 0           $self->__beep();
470             }
471             else {
472 0           $self->{pos}[ROW]--;
473 0 0         if ( $self->{pos}[ROW] >= $self->{first_page_row} ) {
474 0           $self->__wr_cell( $self->{pos}[ROW] + 1, $self->{pos}[COL] );
475 0           $self->__wr_cell( $self->{pos}[ROW] , $self->{pos}[COL] );
476             }
477             else {
478 0           $self->{last_page_row} = $self->{first_page_row} - 1;
479 0           $self->{first_page_row} = $self->{first_page_row} - $self->{avail_height};
480 0 0         $self->{first_page_row} = 0 if $self->{first_page_row} < 0;
481 0           $self->__wr_screen();
482             }
483             }
484             }
485             elsif ( $key == KEY_TAB || $key == CONTROL_I ) { # KEY_TAB == CONTROL_I
486 0 0 0       if ( $self->{pos}[ROW] == $#{$self->{rc2idx}}
  0            
487 0           && $self->{pos}[COL] == $#{$self->{rc2idx}[$self->{pos}[ROW]]}
488             ) {
489 0           $self->__beep();
490             }
491             else {
492 0 0         if ( $self->{pos}[COL] < $#{$self->{rc2idx}[$self->{pos}[ROW]]} ) {
  0            
493 0           $self->{pos}[COL]++;
494 0           $self->__wr_cell( $self->{pos}[ROW], $self->{pos}[COL] - 1 );
495 0           $self->__wr_cell( $self->{pos}[ROW], $self->{pos}[COL] );
496             }
497             else {
498 0           $self->{pos}[ROW]++;
499 0 0         if ( $self->{pos}[ROW] <= $self->{last_page_row} ) {
500 0           $self->{pos}[COL] = 0;
501 0           $self->__wr_cell( $self->{pos}[ROW] - 1, $#{$self->{rc2idx}[$self->{pos}[ROW] - 1]} );
  0            
502 0           $self->__wr_cell( $self->{pos}[ROW] , $self->{pos}[COL] );
503             }
504             else {
505 0           $self->{first_page_row} = $self->{last_page_row} + 1;
506 0           $self->{last_page_row} = $self->{last_page_row} + $self->{avail_height};
507 0 0         $self->{last_page_row} = $#{$self->{rc2idx}} if $self->{last_page_row} > $#{$self->{rc2idx}};
  0            
  0            
508 0           $self->{pos}[COL] = 0;
509 0           $self->__wr_screen();
510             }
511             }
512             }
513             }
514             elsif ( $key == KEY_BSPACE || $key == KEY_BTAB || $key == CONTROL_H ) { # KEY_BTAB == CONTROL_H
515 0 0 0       if ( $self->{pos}[COL] == 0 && $self->{pos}[ROW] == 0 ) {
516 0           $self->__beep();
517             }
518             else {
519 0 0         if ( $self->{pos}[COL] > 0 ) {
520 0           $self->{pos}[COL]--;
521 0           $self->__wr_cell( $self->{pos}[ROW], $self->{pos}[COL] + 1 );
522 0           $self->__wr_cell( $self->{pos}[ROW], $self->{pos}[COL] );
523             }
524             else {
525 0           $self->{pos}[ROW]--;
526 0 0         if ( $self->{pos}[ROW] >= $self->{first_page_row} ) {
527 0           $self->{pos}[COL] = $#{$self->{rc2idx}[$self->{pos}[ROW]]};
  0            
528 0           $self->__wr_cell( $self->{pos}[ROW] + 1, 0 );
529 0           $self->__wr_cell( $self->{pos}[ROW] , $self->{pos}[COL] );
530             }
531             else {
532 0           $self->{last_page_row} = $self->{first_page_row} - 1;
533 0           $self->{first_page_row} = $self->{first_page_row} - $self->{avail_height};
534 0 0         $self->{first_page_row} = 0 if $self->{first_page_row} < 0;
535 0           $self->{pos}[COL] = $#{$self->{rc2idx}[$self->{pos}[ROW]]};
  0            
536 0           $self->__wr_screen();
537             }
538             }
539             }
540             }
541             elsif ( $key == VK_RIGHT || $key == KEY_l ) {
542 0 0         if ( $self->{pos}[COL] == $#{$self->{rc2idx}[$self->{pos}[ROW]]} ) {
  0            
543 0           $self->__beep();
544             }
545             else {
546 0           $self->{pos}[COL]++;
547 0           $self->__wr_cell( $self->{pos}[ROW], $self->{pos}[COL] - 1 );
548 0           $self->__wr_cell( $self->{pos}[ROW], $self->{pos}[COL] );
549             }
550             }
551             elsif ( $key == VK_LEFT || $key == KEY_h ) {
552 0 0         if ( $self->{pos}[COL] == 0 ) {
553 0           $self->__beep();
554             }
555             else {
556 0           $self->{pos}[COL]--;
557 0           $self->__wr_cell( $self->{pos}[ROW], $self->{pos}[COL] + 1 );
558 0           $self->__wr_cell( $self->{pos}[ROW], $self->{pos}[COL] );
559             }
560             }
561             elsif ( $key == VK_PAGE_UP || $key == CONTROL_P ) {
562 0 0         if ( $self->{first_page_row} <= 0 ) {
563 0           $self->__beep();
564             }
565             else {
566 0           $self->{first_page_row} = $self->{avail_height} * ( int( $self->{pos}[ROW] / $self->{avail_height} ) - $page_step );
567 0           $self->{last_page_row} = $self->{first_page_row} + $self->{avail_height} - 1;
568 0 0         if ( $saved_pos ) {
569 0           $self->{pos}[ROW] = $saved_pos->[ROW] + $self->{first_page_row};
570 0           $self->{pos}[COL] = $saved_pos->[COL];
571 0           $saved_pos = undef;
572             }
573             else {
574 0           $self->{pos}[ROW] -= $self->{avail_height} * $page_step;
575             }
576 0           $self->__wr_screen();
577             }
578             }
579             elsif ( $key == VK_PAGE_DOWN || $key == CONTROL_N ) {
580 0 0         if ( $self->{last_page_row} >= $#{$self->{rc2idx}} ) {
  0            
581 0           $self->__beep();
582             }
583             else {
584 0           my $backup_p_begin = $self->{first_page_row};
585 0           $self->{first_page_row} = $self->{avail_height} * ( int( $self->{pos}[ROW] / $self->{avail_height} ) + $page_step );
586 0           $self->{last_page_row} = $self->{first_page_row} + $self->{avail_height} - 1;
587 0 0         $self->{last_page_row} = $#{$self->{rc2idx}} if $self->{last_page_row} > $#{$self->{rc2idx}};
  0            
  0            
588 0 0 0       if ( $self->{pos}[ROW] + $self->{avail_height} > $#{$self->{rc2idx}}
  0            
589 0           || $self->{pos}[COL] > $#{$self->{rc2idx}[$self->{pos}[ROW] + $self->{avail_height}]}
590             ) {
591 0           $saved_pos = [ $self->{pos}[ROW] - $backup_p_begin, $self->{pos}[COL] ];
592 0           $self->{pos}[ROW] = $#{$self->{rc2idx}};
  0            
593 0 0         if ( $self->{pos}[COL] > $#{$self->{rc2idx}[$self->{pos}[ROW]]} ) {
  0            
594 0           $self->{pos}[COL] = $#{$self->{rc2idx}[$self->{pos}[ROW]]};
  0            
595             }
596             }
597             else {
598 0           $self->{pos}[ROW] += $self->{avail_height} * $page_step;
599             }
600 0           $self->__wr_screen();
601             }
602             }
603             elsif ( $key == VK_HOME || $key == CONTROL_A ) {
604 0 0 0       if ( $self->{pos}[COL] == 0 && $self->{pos}[ROW] == 0 ) {
605 0           $self->__beep();
606             }
607             else {
608 0           $self->{pos}[ROW] = 0;
609 0           $self->{pos}[COL] = 0;
610 0           $self->{first_page_row} = 0;
611 0           $self->{last_page_row} = $self->{first_page_row} + $self->{avail_height} - 1;
612 0 0         $self->{last_page_row} = $#{$self->{rc2idx}} if $self->{last_page_row} > $#{$self->{rc2idx}};
  0            
  0            
613 0           $self->__wr_screen();
614             }
615             }
616             elsif ( $key == VK_END || $key == CONTROL_E ) {
617 0 0 0       if ( $self->{order} == 1 && $self->{idx_of_last_col_in_last_row} < $#{$self->{rc2idx}[0]} ) {
  0            
618 0 0 0       if ( $self->{pos}[ROW] == $#{$self->{rc2idx}} - 1
  0            
619 0           && $self->{pos}[COL] == $#{$self->{rc2idx}[$self->{pos}[ROW]]}
620             ) {
621 0           $self->__beep();
622             }
623             else {
624 0   0       $self->{first_page_row} = @{$self->{rc2idx}} - ( @{$self->{rc2idx}} % $self->{avail_height} || $self->{avail_height} );
  0            
625 0           $self->{pos}[ROW] = $#{$self->{rc2idx}} - 1;
  0            
626 0           $self->{pos}[COL] = $#{$self->{rc2idx}[$self->{pos}[ROW]]};
  0            
627 0 0         if ( $self->{first_page_row} == $#{$self->{rc2idx}} ) {
  0            
628 0           $self->{first_page_row} = $self->{first_page_row} - $self->{avail_height};
629 0           $self->{last_page_row} = $self->{first_page_row} + $self->{avail_height} - 1;
630             }
631             else {
632 0           $self->{last_page_row} = $#{$self->{rc2idx}};
  0            
633             }
634 0           $self->__wr_screen();
635             }
636             }
637             else {
638 0 0 0       if ( $self->{pos}[ROW] == $#{$self->{rc2idx}}
  0            
639 0           && $self->{pos}[COL] == $#{$self->{rc2idx}[$self->{pos}[ROW]]}
640             ) {
641 0           $self->__beep();
642             }
643             else {
644 0   0       $self->{first_page_row} = @{$self->{rc2idx}} - ( @{$self->{rc2idx}} % $self->{avail_height} || $self->{avail_height} );
  0            
645 0           $self->{last_page_row} = $#{$self->{rc2idx}};
  0            
646 0           $self->{pos}[ROW] = $#{$self->{rc2idx}};
  0            
647 0           $self->{pos}[COL] = $#{$self->{rc2idx}[$self->{pos}[ROW]]};
  0            
648 0           $self->__wr_screen();
649             }
650             }
651             }
652             elsif ( $key == KEY_q || $key == CONTROL_Q ) {
653 0           $self->__reset_term( 1 );
654 0           return;
655             }
656             elsif ( $key == CONTROL_C ) {
657 0           $self->__reset_term( 1 );
658 0           print STDERR "^C\n";
659 0           exit 1;
660             }
661             elsif ( $key == LINE_FEED || $key == CARRIAGE_RETURN ) { # LINE_FEED == CONTROL_J, CARRIAGE_RETURN == CONTROL_M # ENTER key
662 0 0         if ( length $self->{search_info} ) {
663 0           require Term::Choose::Opt::Search;
664 0           $self->Term::Choose::Opt::Search::__search_end();
665 0           next GET_KEY;
666             }
667 0   0       my $opt_index = $self->{index} || $self->{ll};
668 0           my $list_idx = $self->{rc2idx}[$self->{pos}[ROW]][$self->{pos}[COL]];
669 0 0         if ( ! defined $self->{wantarray} ) {
    0          
670 0           $self->__reset_term( 1 );
671 0           return;
672             }
673             elsif ( $self->{wantarray} ) {
674 0 0         if ( $self->{include_highlighted} == 1 ) {
    0          
675 0           $self->{marked}[$self->{pos}[ROW]][$self->{pos}[COL]] = 1;
676             }
677             elsif ( $self->{include_highlighted} == 2 ) {
678 0           my $chosen = $self->__marked_rc2idx();
679 0 0         if ( ! @$chosen ) {
680 0           $self->{marked}[$self->{pos}[ROW]][$self->{pos}[COL]] = 1;
681             }
682             }
683 0 0 0       if ( defined $self->{meta_items} && ! $self->{marked}[$self->{pos}[ROW]][$self->{pos}[COL]] ) {
684 0           for my $meta_item ( @{$self->{meta_items}} ) {
  0            
685 0 0         if ( $meta_item == $list_idx ) {
686 0           $self->{marked}[$self->{pos}[ROW]][$self->{pos}[COL]] = 1;
687 0           last;
688             }
689             }
690             }
691 0           my $chosen = $self->__marked_rc2idx();
692 0           $self->__reset_term( 1 );
693 0 0         return $opt_index ? @$chosen : @{$orig_list_ref}[@$chosen];
  0            
694             }
695             else {
696 0 0         my $chosen = $opt_index ? $list_idx : $orig_list_ref->[$list_idx];
697 0           $self->__reset_term( 1 );
698 0           return $chosen;
699             }
700             }
701             elsif ( $key == KEY_SPACE ) {
702 0 0         if ( $self->{wantarray} ) {
703 0           my $list_idx = $self->{rc2idx}[$self->{pos}[ROW]][$self->{pos}[COL]];
704 0           my $locked = 0;
705 0 0 0       if ( defined $self->{no_spacebar} || defined $self->{meta_items} ) {
706 0 0         for my $no_spacebar ( @{$self->{no_spacebar}||[]}, @{$self->{meta_items}||[]} ) {
  0 0          
  0            
707 0 0         if ( $list_idx == $no_spacebar ) {
708 0           ++$locked;
709 0           last;
710             }
711             }
712             }
713 0 0         if ( $locked ) {
714 0           $self->__beep();
715             }
716             else {
717 0           $self->{marked}[$self->{pos}[ROW]][$self->{pos}[COL]] = ! $self->{marked}[$self->{pos}[ROW]][$self->{pos}[COL]];
718 0           $self->__wr_cell( $self->{pos}[ROW], $self->{pos}[COL] );
719             }
720             }
721             else {
722 0           $self->__beep();
723             }
724             }
725             elsif ( $key == CONTROL_SPACE ) {
726 0 0         if ( $self->{wantarray} ) {
727 0           for my $i ( 0 .. $#{$self->{rc2idx}} ) {
  0            
728 0           for my $j ( 0 .. $#{$self->{rc2idx}[$i]} ) {
  0            
729 0           $self->{marked}[$i][$j] = ! $self->{marked}[$i][$j];
730             }
731             }
732 0 0         if ( $self->{skip_items} ) {
733 0           $self->Term::Choose::Opt::SkipItems::__unmark_skip_items();
734             }
735 0 0         if ( defined $self->{no_spacebar} ) {
736 0           $self->__marked_idx2rc( $self->{no_spacebar}, 0 );
737             }
738 0 0         if ( defined $self->{meta_items} ) {
739 0           $self->__marked_idx2rc( $self->{meta_items}, 0 );
740             }
741              
742 0           $self->__wr_screen();
743             }
744             else {
745 0           $self->__beep();
746             }
747             }
748             elsif ( $key == CONTROL_F && $self->{search} ) {
749 0           require Term::Choose::Opt::Search;
750 0 0         if ( $self->{ll} ) {
751 0           $ENV{TC_POS_AT_SEARCH} = $self->{rc2idx}[$self->{pos}[ROW]][$self->{pos}[COL]];
752 0           $self->__reset_term( 0 );
753 0           return -13;
754             }
755 0 0         if ( length $self->{search_info} ) {
756 0           $self->Term::Choose::Opt::Search::__search_end();
757             }
758 0           $self->Term::Choose::Opt::Search::__search_begin();
759             }
760             else {
761 0           $self->__beep();
762             }
763             }
764             }
765              
766              
767             sub __beep {
768 0     0     my ( $self, $beep ) = @_;
769 0 0         if ( $beep ) {
770 0           print bell();
771             }
772             }
773              
774              
775             sub __wr_first_screen {
776 0     0     my ( $self ) = @_;
777 0           my $info_w = $self->{term_width} + EXTRA_W;
778 0           for my $opt ( qw( info prompt bottom_text ) ) {
779 0 0         if ( length $self->{$opt} ) {
780 0   0       my $init = $self->{'tabs_' . $opt}[0] // 0;
781 0   0       my $subseq = $self->{'tabs_' . $opt}[1] // 0;
782 0   0       my $r_margin = $self->{'tabs_' . $opt}[2] // 0;
783 0 0 0       if ( $init + $r_margin > $info_w - 6 || $subseq + $r_margin > $info_w - 6 ) { ##
784 0           ( $init, $subseq, $r_margin ) = ( 0, 0, 0 );
785             }
786 0           my $width = $info_w - $r_margin;
787 0 0 0       if ( $self->{max_width} && $width > $self->{max_width} ) {
788 0   0       $width = $self->{max_width} + ( $self->{margin_left} // 0 ); ##
789             }
790             $self->{$opt . '_rows'} = [ line_fold(
791             $self->{$opt}, { width => $width, init_tab => $init, subseq_tab => $subseq,
792 0           color => $self->{color}, join => 0 }
793             ) ];
794             }
795             }
796 0           $self->__avail_screen_size();
797 0           $self->__current_layout();
798 0           $self->__list_idx2rc();
799 0           $self->__prepare_footer_line();
800 0           $self->{first_page_row} = 0;
801 0 0         if ( $#{$self->{rc2idx}} > $self->{avail_height} - 1 ) {
  0            
802 0           $self->{last_page_row} = $self->{avail_height} - 1;
803             }
804             else {
805 0           $self->{last_page_row} = $#{$self->{rc2idx}};
  0            
806             }
807 0           $self->{i_row} = 0;
808 0           $self->{i_col} = 0;
809 0           $self->{pos} = [ 0, 0 ];
810 0           $self->{marked} = [];
811 0 0 0       if ( $self->{wantarray} && defined $self->{mark} ) {
812 0           $self->__marked_idx2rc( $self->{mark}, 1 );
813             }
814 0 0 0       if ( defined $self->{default} && $self->{default} <= $#{$self->{list}} ) {
  0            
815 0           $self->__set_cell( $self->{default} );
816             }
817 0 0         if ( $self->{clear_screen} ) {
818 0           print clear_screen();
819             }
820             else {
821 0           print "\r" . clear_to_end_of_screen();
822             }
823 0           my $pre_string;
824 0 0         $pre_string .= "\n" x $self->{margin_top} if $self->{margin_top};
825 0 0         $pre_string .= join( "\n\r", @{$self->{info_rows}} ) . "\n\r" if $self->{info_rows};
  0            
826 0 0         $pre_string .= join( "\n\r", @{$self->{prompt_rows}} ) . "\n\r" if $self->{prompt_rows};
  0            
827 0 0         if ( length $self->{search_info} ) {
828 0 0         $pre_string .= ( $self->{margin_left} ? ' ' x $self->{margin_left} : '' ) . $self->{search_info} . "\n\r";
829             }
830             # \n\r -> stty 'raw' mode and Term::Readkey 'ultra-raw' mode don't translate newline to carriage_return/newline
831 0 0         if ( length $pre_string ) {
832 0           print $pre_string;
833             }
834 0           $self->__wr_screen();
835 0 0         if ( $self->{mouse} ) {
836 0           my $abs_cursor_y = $self->{plugin}->__get_cursor_row();
837 0           $self->{offset_rows} = $abs_cursor_y - 1 - $self->{i_row};
838             }
839             }
840              
841              
842             sub __avail_screen_size {
843 0     0     my ( $self ) = @_;
844 0           ( $self->{avail_width}, $self->{avail_height} ) = ( $self->{term_width}, $self->{term_height} );
845 0 0 0       if ( $self->{margin_right} || ( $self->{col_width} > $self->{avail_width} ) ) {
846 0           $self->{avail_width} += EXTRA_W;
847             # + EXTRA_W: use also the last terminal column if there is only one item-column;
848             # with only one item-column the output doesn't get messed up if an item
849             # reaches the right edge of the terminal on a non-MSWin32-OS (EXTRA_W is 0 if OS is MSWin32)
850             }
851 0 0         $self->{avail_width} -= $self->{margin_left} if $self->{margin_left};
852 0 0         $self->{avail_width} -= $self->{margin_right} if $self->{margin_right};
853 0 0         if ( $self->{avail_width} < 6 ) { ##
854 0           delete $self->{margin_right};
855 0           delete $self->{margin_left};
856 0           $self->{avail_width} = $self->{term_width};
857 0 0         $self->{avail_width} += EXTRA_W if $self->{col_width} > $self->{avail_width};
858             }
859 0 0 0       if ( $self->{max_width} && $self->{avail_width} > $self->{max_width} ) {
860 0           $self->{avail_width} = $self->{max_width};
861             }
862             #if ( $self->{ll} && $self->{ll} > $self->{avail_width} ) {
863             # return -2;
864             #}
865 0 0         $self->{avail_height} -= $self->{margin_top} if $self->{margin_top};
866 0 0         $self->{avail_height} -= @{$self->{info_rows}} if $self->{info_rows};
  0            
867 0 0         $self->{avail_height} -= @{$self->{prompt_rows}} if $self->{prompt_rows};
  0            
868 0 0         $self->{avail_height}-- if length $self->{search_info};
869 0 0         $self->{avail_height}-- if $self->{page};
870 0 0         $self->{avail_height} -= @{$self->{bottom_text_rows}} if $self->{bottom_text_rows};
  0            
871 0 0         $self->{avail_height} -= $self->{margin_bottom} if $self->{margin_bottom};
872 0 0         if ( $self->{avail_height} < $self->{keep} ) {
873 0           $self->__avail_height_to_keep();
874             }
875 0 0 0       if ( $self->{max_height} && $self->{avail_height} > $self->{max_height} ) { ##
876 0           $self->{avail_height} = $self->{max_height};
877             }
878 0   0       $self->{count_pre_rows} = ( $self->{margin_top} // 0 ) + @{$self->{info_rows}//[]} + @{$self->{prompt_rows}//[]};
  0   0        
  0   0        
879 0 0         if ( length $self->{search_info} ) {
880 0           ++$self->{count_pre_rows};
881             }
882             }
883              
884              
885             sub __avail_height_to_keep {
886 0     0     my ( $self ) = @_;
887 0           my $keep = $self->{keep};
888 0 0         if ( $self->{layout} == 2 ) {
889 0 0         if ( $keep > @{$self->{list}} ) {
  0            
890 0           $keep = @{$self->{list}};
  0            
891             }
892             }
893             else {
894 0           $keep = $self->__keep_to_row_count( $keep );
895             }
896 0 0         if ( $keep <= $self->{avail_height} ) {
897 0           return;
898             }
899 0 0 0       if ( $self->{margin_top} || $self->{margin_bottom} ) {
900              
901 0           REDUCE: while ( 1 ) {
902 0           my $prev_avail_height = $self->{avail_height};
903              
904 0           for my $margin_type ( qw( margin_top margin_bottom ) ) {
905 0 0         if ( $self->{$margin_type} ) {
906 0           --$self->{$margin_type};
907 0           ++$self->{avail_height};
908 0 0         last REDUCE if $self->{avail_height} == $keep;
909             }
910             }
911 0 0         last REDUCE if $prev_avail_height == $self->{avail_height};
912             }
913             }
914 0 0         if ( $keep <= $self->{avail_height} ) {
915 0           return;
916             }
917 0 0 0       if ( $self->{margin_right} || $self->{margin_left} ) {
918 0   0       my $orig_margin_right = $self->{margin_right} // 0;
919 0   0       my $orig_margin_left = $self->{margin_left} // 0;
920 0 0 0       $self->{margin_right} = $self->{margin_right} && $self->{term_width} > 4 ? 1 : 0; ##
921 0 0 0       $self->{margin_left} = $self->{margin_left} && $self->{term_width} > 4 ? 1 : 0; ##
922              
923 0           for my $opt ( qw( info prompt bottom_text ) ) {
924 0 0         if ( length $self->{$opt} ) {
925             ## don't change tab_prompt, tab_info and tab_text, because they are not restored on win resize.
926             #my $ts = 'tabs_' . $opt;
927             #my $init = defined $self->{$ts}[0] && $self->{$ts}[0] < $self->{margin_left} ? $self->{$ts}[0] : $self->{margin_left};
928             #my $subseq = defined $self->{$ts}[1] && $self->{$ts}[1] < $self->{margin_left} ? $self->{$ts}[1] : $self->{margin_left};
929             #my $r_margin = defined $self->{$ts}[2] && $self->{$ts}[2] < $self->{margin_right} ? $self->{$ts}[2] : $self->{margin_right};
930 0           my $init = $self->{margin_left};
931 0           my $subseq = $self->{margin_left};
932 0           my $r_margin = $self->{margin_right};
933 0           my $prev_row_count = @{$self->{$opt . '_rows'}};
  0            
934             $self->{$opt . '_rows'} = [ line_fold(
935             $self->{$opt}, { width => $self->{term_width} + EXTRA_W - $r_margin, init_tab => $init,
936 0           subseq_tab => $subseq, color => $self->{color}, join => 0 }
937             ) ];
938 0           $self->{avail_height} += $prev_row_count - @{$self->{$opt . '_rows'}};
  0            
939             }
940             }
941 0           $self->{avail_width} += ( $orig_margin_right - $self->{margin_right} ) + ( $orig_margin_left - $self->{margin_left} );
942 0           $keep = $self->__keep_to_row_count( $keep );
943             }
944 0 0         if ( $keep <= $self->{avail_height} ) {
945 0           return;
946             }
947 0 0         if ( $self->{info_rows} ) {
948             # Text rows above the menu (info_rows, prompt_rows, search_info) are not deleted. They are pushed upwards
949             # out of the terminal when the space reserved for them is deleted.
950 0 0         if ( @{$self->{info_rows}} >= $keep - $self->{avail_height} ) {
  0            
951 0           $self->{avail_height} = $keep;
952             }
953             else {
954 0           $self->{avail_height} += @{$self->{info_rows}};
  0            
955             }
956             }
957 0 0         if ( $keep <= $self->{avail_height} ) {
958 0           return;
959             }
960 0 0         if ( $self->{bottom_text_rows} ) {
961 0 0         if ( @{$self->{bottom_text_rows}} > $keep - $self->{avail_height} ) {
  0            
962 0           splice( @{$self->{bottom_text_rows}}, -( $keep - $self->{avail_height} ) );
  0            
963             # bottom_text_rows are deleted because they are below the menu.
964 0           $self->{avail_height} = $keep;
965 0           my $ellipsis = '...';
966 0           my $ellipsis_w = length $ellipsis;
967 0   0       my $avail_w = $self->{avail_width} + EXTRA_W + ( $self->{margin_left} // 0 );
968 0 0         if ( $avail_w >= $ellipsis_w ) {
969 0           while ( print_columns( $self->{bottom_text_rows}[-1] ) + $ellipsis_w > $avail_w ) {
970 0           $self->{bottom_text_rows}[-1] =~ s/.\z//;
971             }
972 0           $self->{bottom_text_rows}[-1] .= $ellipsis;
973             }
974             }
975             else {
976 0           $self->{avail_height} += @{$self->{bottom_text_rows}};
  0            
977 0           delete $self->{bottom_text_rows};
978             }
979             }
980 0 0         if ( $keep <= $self->{avail_height} ) {
981 0           return;
982             }
983 0 0         if ( $self->{prompt_rows} ) {
984 0 0         if ( @{$self->{prompt_rows}} > $keep - $self->{avail_height} ) {
  0            
985 0           $self->{avail_height} = $keep;
986             }
987             else {
988 0 0         if ( $self->{avail_height} + @{$self->{prompt_rows}} > 4 ) {
  0            
989             # keep the last prompt line
990 0           $self->{avail_height} += @{$self->{prompt_rows}} - 1;
  0            
991 0           --$keep;
992             }
993             else {
994 0           $self->{avail_height} += @{$self->{prompt_rows}};
  0            
995             }
996             }
997             }
998 0 0         if ( $keep <= $self->{avail_height} ) {
999 0           return;
1000             }
1001 0 0         if ( length $self->{search_info} ) {
1002 0 0         if ( $self->{avail_height} > 2 ) {
1003 0           --$keep;
1004             }
1005             else {
1006 0           ++$self->{avail_height};
1007             }
1008             }
1009 0 0         if ( $keep <= $self->{avail_height} ) {
1010 0           return;
1011             }
1012 0 0         if ( $self->{page} ) {
1013 0           --$keep;
1014             }
1015             #if ( $self->{page} ) {
1016             # if ( $self->{avail_height} > 1 ) {
1017             # --$keep;
1018             # }
1019             # else {
1020             # ++$self->{avail_height};
1021             # delete $self->{footer_fmt};
1022             # }
1023             #}
1024             }
1025              
1026              
1027             sub __keep_to_row_count {
1028 0     0     my ( $self, $keep ) = @_;
1029 0           my $row_w = $self->{col_width};
1030 0           my $count = 1;
1031              
1032 0           while ( 1 ) { ##
1033 0           $row_w += $self->{pad} + $self->{col_width};
1034 0 0         if ( $row_w >= $self->{avail_width} ) {
1035 0           last;
1036             }
1037 0           ++$count;
1038             }
1039 0           my $rows = int( @{$self->{list}} / $count );
  0            
1040 0 0         if ( @{$self->{list}} % $count ) {
  0            
1041 0           ++$rows;
1042             }
1043 0 0         if ( $keep > $rows ) {
1044 0           $keep = $rows;
1045             }
1046 0           return $keep;
1047             }
1048              
1049              
1050             sub __current_layout {
1051 0     0     my ( $self ) = @_;
1052 0           my $all_in_first_row;
1053 0 0 0       if ( $self->{layout} <= 1 && ! $self->{ll} && ! $self->{max_cols} ) {
      0        
1054 0           my $firstrow_width = 0;
1055 0           for my $list_idx ( 0 .. $#{$self->{list}} ) {
  0            
1056 0           $firstrow_width += $self->{width_elements}[$list_idx] + $self->{pad};
1057 0 0         if ( $firstrow_width - $self->{pad} > $self->{avail_width} ) {
1058 0           $firstrow_width = 0;
1059 0           last;
1060             }
1061             }
1062 0           $all_in_first_row = $firstrow_width;
1063             }
1064 0 0         if ( $all_in_first_row ) {
    0          
1065 0           $self->{current_layout} = -1;
1066             }
1067             elsif ( $self->{col_width} >= $self->{avail_width} ) {
1068 0           $self->{current_layout} = 2;
1069 0           $self->{col_width} = $self->{avail_width};
1070             }
1071             else {
1072 0           $self->{current_layout} = $self->{layout};
1073             }
1074 0           $self->{col_width_plus} = $self->{col_width} + $self->{pad};
1075             # 'col_width_plus' no effects if layout == 2
1076             }
1077              
1078              
1079             sub __list_idx2rc {
1080 0     0     my ( $self ) = @_;
1081 0           $self->{rc2idx} = [];
1082 0 0         if ( $self->{current_layout} == -1 ) {
    0          
1083 0           $self->{rc2idx}[0] = [ 0 .. $#{$self->{list}} ];
  0            
1084 0           $self->{idx_of_last_col_in_last_row} = $#{$self->{list}};
  0            
1085             }
1086             elsif ( $self->{current_layout} == 2 ) {
1087 0           for my $list_idx ( 0 .. $#{$self->{list}} ) {
  0            
1088 0           $self->{rc2idx}[$list_idx][0] = $list_idx;
1089 0           $self->{idx_of_last_col_in_last_row} = 0;
1090             }
1091             }
1092             else {
1093 0           my $tmp_avail_width = $self->{avail_width} + $self->{pad};
1094             # auto_format
1095 0 0         if ( $self->{current_layout} == 1 ) {
1096 0           my $tmc = int( @{$self->{list}} / $self->{avail_height} );
  0            
1097 0 0         $tmc++ if @{$self->{list}} % $self->{avail_height};
  0            
1098 0           $tmc *= $self->{col_width_plus};
1099 0 0         if ( $tmc < $tmp_avail_width ) {
1100 0           $tmc = int( $tmc + ( ( $tmp_avail_width - $tmc ) / 1.5 ) );
1101 0           $tmp_avail_width = $tmc;
1102             }
1103             }
1104             # order
1105 0           my $cols_per_row = int( $tmp_avail_width / $self->{col_width_plus} );
1106 0 0 0       if ( $self->{max_cols} && $cols_per_row > $self->{max_cols} ) {
1107 0           $cols_per_row = $self->{max_cols};
1108             }
1109 0 0         $cols_per_row = 1 if $cols_per_row < 1;
1110 0   0       $self->{idx_of_last_col_in_last_row} = ( @{$self->{list}} % $cols_per_row || $cols_per_row ) - 1;
1111 0 0         if ( $self->{order} == 1 ) {
1112 0           my $rows = int( ( @{$self->{list}} - 1 + $cols_per_row ) / $cols_per_row );
  0            
1113 0           my @rearranged_idx;
1114 0           my $begin = 0;
1115 0           my $end = $rows - 1 ;
1116 0           for my $c ( 0 .. $cols_per_row - 1 ) {
1117 0 0         --$end if $c > $self->{idx_of_last_col_in_last_row};
1118 0           $rearranged_idx[$c] = [ $begin .. $end ];
1119 0           $begin = $end + 1;
1120 0           $end = $begin + $rows - 1;
1121             }
1122 0           for my $r ( 0 .. $rows - 1 ) {
1123 0           my @temp_idx;
1124 0           for my $c ( 0 .. $cols_per_row - 1 ) {
1125 0 0 0       next if $r == $rows - 1 && $c > $self->{idx_of_last_col_in_last_row};
1126 0           push @temp_idx, $rearranged_idx[$c][$r];
1127             }
1128 0           push @{$self->{rc2idx}}, \@temp_idx;
  0            
1129             }
1130             }
1131             else {
1132 0           my $begin = 0;
1133 0           my $end = $cols_per_row - 1;
1134 0 0         $end = $#{$self->{list}} if $end > $#{$self->{list}};
  0            
  0            
1135 0           push @{$self->{rc2idx}}, [ $begin .. $end ];
  0            
1136 0           while ( $end < $#{$self->{list}} ) {
  0            
1137 0           $begin += $cols_per_row;
1138 0           $end += $cols_per_row;
1139 0 0         $end = $#{$self->{list}} if $end > $#{$self->{list}};
  0            
  0            
1140 0           push @{$self->{rc2idx}}, [ $begin .. $end ];
  0            
1141             }
1142             }
1143             }
1144             }
1145              
1146              
1147             sub __prepare_footer_line {
1148 0     0     my ( $self ) = @_;
1149 0 0         if ( exists $self->{footer_fmt} ) {
1150 0           delete $self->{footer_fmt};
1151             }
1152 0           my $pp_total = int( $#{$self->{rc2idx}} / $self->{avail_height} ) + 1; ##
  0            
1153 0 0 0       if ( $self->{page} == 0 ) {
    0          
1154             # nothing to do
1155             }
1156             elsif ( $self->{page} == 1 && $pp_total == 1 ) {
1157 0           $self->{avail_height}++;
1158             }
1159             else {
1160 0           my $pp_total_width = length $pp_total;
1161 0           $self->{footer_fmt} = '--- %0' . $pp_total_width . 'd/' . $pp_total . ' --- ';
1162 0 0         if ( defined $self->{footer} ) {
1163 0           $self->{footer_fmt} .= $self->{footer};
1164             }
1165 0 0         if ( print_columns( sprintf $self->{footer_fmt}, $pp_total ) > $self->{avail_width} ) { # color
1166 0           $self->{footer_fmt} = '%0' . $pp_total_width . 'd/' . $pp_total;
1167 0 0         if ( length( sprintf $self->{footer_fmt}, $pp_total ) > $self->{avail_width} ) {
1168 0 0         $pp_total_width = $self->{avail_width} if $pp_total_width > $self->{avail_width};
1169 0           $self->{footer_fmt} = '%0' . $pp_total_width . '.' . $pp_total_width . 's';
1170             }
1171             }
1172 0 0         if ( $self->{margin_left} ) {
1173 0           $self->{footer_fmt} = ( ' ' x $self->{margin_left} ) . $self->{footer_fmt};
1174             }
1175             }
1176 0           $self->{pp_count} = $pp_total;
1177             }
1178              
1179              
1180             sub __marked_idx2rc {
1181 0     0     my ( $self, $list_of_indexes, $boolean ) = @_;
1182 0           my $last_list_idx = $#{$self->{list}};
  0            
1183 0 0         if ( $self->{current_layout} == 2 ) {
1184 0           for my $list_idx ( @$list_of_indexes ) {
1185 0 0         if ( $list_idx > $last_list_idx ) {
1186 0           next;
1187             }
1188 0           $self->{marked}[$list_idx][0] = $boolean;
1189             }
1190 0           return;
1191             }
1192 0           my ( $row, $col );
1193 0           my $cols_per_row = @{$self->{rc2idx}[0]};
  0            
1194 0 0         if ( $self->{order} == 0 ) {
    0          
1195 0           for my $list_idx ( @$list_of_indexes ) {
1196 0 0         if ( $list_idx > $last_list_idx ) {
1197 0           next;
1198             }
1199 0           $row = int( $list_idx / $cols_per_row );
1200 0           $col = $list_idx % $cols_per_row;
1201 0           $self->{marked}[$row][$col] = $boolean;
1202             }
1203             }
1204             elsif ( $self->{order} == 1 ) {
1205 0           my $rows_per_col = @{$self->{rc2idx}};
  0            
1206 0           my $col_count_last_row = $self->{idx_of_last_col_in_last_row} + 1;
1207 0           my $last_list_idx_in_cols_full = $rows_per_col * $col_count_last_row - 1;
1208 0           my $first_list_idx_in_cols_short = $last_list_idx_in_cols_full + 1;
1209              
1210 0           for my $list_idx ( @$list_of_indexes ) {
1211 0 0         if ( $list_idx > $last_list_idx ) {
1212 0           next;
1213             }
1214 0 0         if ( $list_idx < $last_list_idx_in_cols_full ) {
1215 0           $row = $list_idx % $rows_per_col;
1216 0           $col = int( $list_idx / $rows_per_col );
1217             }
1218             else {
1219 0           my $rows_per_col_short = $rows_per_col - 1;
1220 0           $row = ( $list_idx - $first_list_idx_in_cols_short ) % $rows_per_col_short;
1221 0           $col = int( ( $list_idx - $col_count_last_row ) / $rows_per_col_short );
1222             }
1223 0           $self->{marked}[$row][$col] = $boolean;
1224             }
1225             }
1226             }
1227              
1228              
1229             sub __set_cell {
1230 0     0     my ( $self, $list_idx ) = @_;
1231 0 0         if ( $self->{current_layout} == 2 ) {
1232 0           $self->{pos} = [ $list_idx, 0 ];
1233             }
1234             else {
1235 0           LOOP: for my $i ( 0 .. $#{$self->{rc2idx}} ) {
  0            
1236 0           for my $j ( 0 .. $#{$self->{rc2idx}[$i]} ) {
  0            
1237 0 0         if ( $list_idx == $self->{rc2idx}[$i][$j] ) {
1238 0           $self->{pos} = [ $i, $j ];
1239 0           last LOOP;
1240             }
1241             }
1242             }
1243             }
1244 0           $self->{first_page_row} = $self->{avail_height} * int( $self->{pos}[ROW] / $self->{avail_height} );
1245 0           $self->{last_page_row} = $self->{first_page_row} + $self->{avail_height} - 1;
1246 0 0         $self->{last_page_row} = $#{$self->{rc2idx}} if $self->{last_page_row} > $#{$self->{rc2idx}};
  0            
  0            
1247             }
1248              
1249              
1250             sub __marked_rc2idx {
1251 0     0     my ( $self ) = @_;
1252 0           my $list_idx = [];
1253 0 0         if ( $self->{order} == 1 ) {
1254 0           for my $col ( 0 .. $#{$self->{rc2idx}[0]} ) {
  0            
1255 0           for my $row ( 0 .. $#{$self->{rc2idx}} ) {
  0            
1256 0 0         if ( $self->{marked}[$row][$col] ) {
1257 0           push @$list_idx, $self->{rc2idx}[$row][$col];
1258             }
1259             }
1260             }
1261             }
1262             else {
1263 0           for my $row ( 0 .. $#{$self->{rc2idx}} ) {
  0            
1264 0           for my $col ( 0 .. $#{$self->{rc2idx}[$row]} ) {
  0            
1265 0 0         if ( $self->{marked}[$row][$col] ) {
1266 0           push @$list_idx, $self->{rc2idx}[$row][$col];
1267             }
1268             }
1269             }
1270             }
1271 0           return $list_idx;
1272             }
1273              
1274              
1275             sub __wr_screen {
1276 0     0     my ( $self ) = @_;
1277 0           $self->__goto( 0, 0 );
1278 0           print "\r" . clear_to_end_of_screen();
1279 0           my $line_feeds;
1280             #if ( $self->{footer_fmt} ) {
1281 0 0 0       if ( $self->{footer_fmt} || $self->{pp_count} > 1 ) { ##
1282 0           $line_feeds = $self->{avail_height};
1283             }
1284             else {
1285 0           $line_feeds = $self->{last_page_row} - $self->{first_page_row} + 1;
1286             }
1287 0           my $up = $line_feeds;
1288 0           my @post_rows;
1289 0 0         if ( $self->{footer_fmt} ) {
1290 0           @post_rows = ( sprintf $self->{footer_fmt}, int( $self->{first_page_row} / $self->{avail_height} ) + 1 );
1291 0           $up += 1;
1292             }
1293 0 0         if ( $self->{bottom_text_rows} ) {
1294 0           push @post_rows, @{$self->{bottom_text_rows}};
  0            
1295 0           $up += @{$self->{bottom_text_rows}};
  0            
1296             }
1297 0 0         if ( $self->{margin_bottom} ) {
1298 0           push @post_rows, ( '' ) x $self->{margin_bottom};
1299 0           $up += $self->{margin_bottom};
1300             }
1301 0           print "\n" x $line_feeds;
1302 0 0         if ( @post_rows ) {
1303             # no leading line-feed because the menu has a trailing line-feed.
1304 0           print join( "\n\r", @post_rows ) . "\r";
1305 0           --$up; # last @post_rows row has no trailing line-feed.
1306             }
1307 0           print up( $up );
1308 0           my $pad_str = ' ' x $self->{pad};
1309 0   0       my $left_margin = ' ' x ( $self->{margin_left} // 0 );
1310              
1311 0           for my $row ( $self->{first_page_row} .. $self->{last_page_row} ) {
1312 0           my $line = $self->__prepare_cell( $row, 0 );
1313 0 0         if ( $#{$self->{rc2idx}[$row]} ) { #
  0            
1314 0           for my $col ( 1 .. $#{$self->{rc2idx}[$row]} ) {
  0            
1315 0           $line = $line . $pad_str . $self->__prepare_cell( $row, $col );
1316             }
1317             }
1318 0 0         if ( $left_margin ) {
1319 0           print $left_margin . $line . "\n\r";
1320             }
1321             else {
1322 0           print $line . "\n\r";
1323             }
1324             }
1325 0           print up( $self->{last_page_row} - $self->{first_page_row} + 1 );
1326             # relativ cursor pos: 0, 0
1327 0 0         if ( $self->{margin_left} ) {
1328 0           print right( $self->{margin_left} ); # reset left margin after "\r"
1329             }
1330 0           $self->__wr_cell( $self->{pos}[ROW], $self->{pos}[COL] );
1331             }
1332              
1333              
1334             sub __prepare_cell {
1335 0     0     my( $self, $row, $col ) = @_;
1336 0   0       my $is_current_pos = $row == $self->{pos}[ROW] && $col == $self->{pos}[COL];
1337 0 0         my $emphasised = ( $self->{marked}[$row][$col] ? bold_underline() : '' ) . ( $is_current_pos ? reverse_video() : '' );
    0          
1338 0           my $idx = $self->{rc2idx}[$row][$col];
1339 0 0         if ( $self->{ll} ) {
1340 0 0         if ( $self->{color} ) {
1341 0           my $str = $self->{list}[$idx];
1342 0 0         if ( $emphasised ) {
1343 0 0 0       if ( $is_current_pos && $self->{color} == 1 ) {
1344             # no color for the selected cell if color == 1
1345 0           $str =~ s/${\SGR_ES}//g;
  0            
1346             }
1347             else {
1348             # keep marked cells marked after color escapes
1349 0           $str =~ s/(${\SGR_ES})/${1}$emphasised/g;
  0            
1350             }
1351 0           $str = $emphasised . $str;
1352             }
1353 0           return $str . normal();
1354             }
1355             else {
1356 0 0         if ( $emphasised ) {
1357 0           return $emphasised . $self->{list}[$idx] . normal();
1358             }
1359             else {
1360 0           return $self->{list}[$idx];
1361             }
1362             }
1363             }
1364             else {
1365 0 0         my $str = $self->{current_layout} == -1 ? $self->{list}[$idx] : $self->__pad_str_to_colwidth( $idx );
1366 0 0         if ( $self->{color} ) {
1367 0           my @color;
1368 0 0         if ( ! $self->{orig_list}[$idx] ) {
1369 0 0         if ( ! defined $self->{orig_list}[$idx] ) {
    0          
1370 0           @color = $self->{undef} =~ /(${\SGR_ES})/g;
  0            
1371             }
1372             elsif ( ! length $self->{orig_list}[$idx] ) {
1373 0           @color = $self->{empty} =~ /(${\SGR_ES})/g;
  0            
1374             }
1375             }
1376             else {
1377 0           @color = $self->{orig_list}[$idx] =~ /(${\SGR_ES})/g;
  0            
1378             }
1379 0 0         if ( $emphasised ) {
1380 0           for ( @color ) {
1381             # keep marked cells marked after color escapes
1382 0           $_ .= $emphasised;
1383             }
1384 0           $str = $emphasised . $str . normal();
1385 0 0 0       if ( $is_current_pos && $self->{color} == 1 ) {
1386             # no color for the selected cell if color == 1
1387 0           @color = ();
1388 0           $str =~ s/${\PH}//g;
  0            
1389             }
1390             }
1391 0 0         if ( @color ) {
1392 0           $str =~ s/${\PH}/shift @color/ge;
  0            
  0            
1393 0 0         if ( ! $emphasised ) {
1394 0           $str .= normal();
1395             }
1396             }
1397 0           return $str;
1398             }
1399             else {
1400 0 0         if ( $emphasised ) {
1401 0           $str = $emphasised . $str . normal();
1402             }
1403 0           return $str;
1404             }
1405             }
1406             }
1407              
1408              
1409             sub __wr_cell {
1410 0     0     my( $self, $row, $col ) = @_;
1411 0           my $idx = $self->{rc2idx}[$row][$col];
1412 0 0         if ( $self->{current_layout} == -1 ) {
1413 0           my $x = 0;
1414 0 0         if ( $col > 0 ) {
1415 0           for my $cl ( 0 .. $col - 1 ) {
1416 0           my $i = $self->{rc2idx}[$row][$cl];
1417 0           $x += $self->{width_elements}[$i] + $self->{pad};
1418             }
1419             }
1420 0           $self->__goto( $row - $self->{first_page_row}, $x );
1421 0           $self->{i_col} = $self->{i_col} + $self->{width_elements}[$idx];
1422             }
1423             else {
1424 0           $self->__goto( $row - $self->{first_page_row}, $col * $self->{col_width_plus} );
1425 0           $self->{i_col} = $self->{i_col} + $self->{col_width};
1426             }
1427 0           print $self->__prepare_cell( $row, $col );
1428             }
1429              
1430              
1431             sub __pad_str_to_colwidth {
1432 0     0     my ( $self, $idx ) = @_;
1433 0 0         if ( $self->{width_elements}[$idx] < $self->{col_width} ) {
    0          
1434 0 0         if ( $self->{alignment} == 0 ) {
    0          
    0          
1435 0           return $self->{list}[$idx] . ( " " x ( $self->{col_width} - $self->{width_elements}[$idx] ) );
1436             }
1437             elsif ( $self->{alignment} == 1 ) {
1438 0           return " " x ( $self->{col_width} - $self->{width_elements}[$idx] ) . $self->{list}[$idx];
1439             }
1440             elsif ( $self->{alignment} == 2 ) {
1441 0           my $all = $self->{col_width} - $self->{width_elements}[$idx];
1442 0           my $half = int( $all / 2 );
1443 0           return ( " " x $half ) . $self->{list}[$idx] . ( " " x ( $all - $half ) );
1444             }
1445             }
1446             elsif ( $self->{width_elements}[$idx] > $self->{col_width} ) {
1447 0 0         if ( $self->{col_width} > 6 ) {
1448 0           return cut_to_printwidth( $self->{list}[$idx], $self->{col_width} - 3 ) . '...';
1449             }
1450             else {
1451 0           return cut_to_printwidth( $self->{list}[$idx], $self->{col_width} );
1452             }
1453             }
1454             else {
1455 0           return $self->{list}[$idx];
1456             }
1457             }
1458              
1459              
1460             sub __goto {
1461 0     0     my ( $self, $newrow, $newcol ) = @_;
1462             # requires up, down, left or right to be 1 or greater
1463 0 0         if ( $newrow > $self->{i_row} ) {
    0          
1464 0           print down( $newrow - $self->{i_row} );
1465 0           $self->{i_row} = $newrow;
1466             }
1467             elsif ( $newrow < $self->{i_row} ) {
1468 0           print up( $self->{i_row} - $newrow );
1469 0           $self->{i_row} = $newrow;
1470             }
1471 0 0         if ( $newcol > $self->{i_col} ) {
    0          
1472 0           print right( $newcol - $self->{i_col} );
1473 0           $self->{i_col} = $newcol;
1474             }
1475             elsif ( $newcol < $self->{i_col} ) {
1476 0           print left( $self->{i_col} - $newcol );
1477 0           $self->{i_col} = $newcol;
1478             }
1479             }
1480              
1481              
1482              
1483              
1484             1;
1485              
1486              
1487             __END__