File Coverage

blib/lib/Term/Choose.pm
Criterion Covered Total %
statement 45 904 4.9
branch 8 542 1.4
condition 0 210 0.0
subroutine 14 39 35.9
pod 2 2 100.0
total 69 1697 4.0


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