| Subject: | get_reply method with new parameters columns and auto_columns |
My problem was to list the choices on multiple columns.
I then changed the method get_reply by adding two parameters:
columns - number of columns
or
auto_columns - 0|1 - determine number of columns to reduce rows
To determine the size of the screen I used Term::ReadKey
I have attached a file with a demonstration and with the modified method.
I will be happy if the change (or equivalent functionality) will be integrated in distribution.
best regards
Guido Brugnara
| Subject: | test_term_ui.pl |
#!/usr/bin/perl
use strict;
use utf8;
binmode(STDOUT, ":utf8");
use Term::UI;
use Term::ReadLine;
my $term = Term::ReadLine->new('my_test');
# With new param 'auto_columns' - determine columns to list choices to reduce rows
my $reply = $term->get_reply(
prompt => 'What is your favourite selection?',
print_me => 'List of choices:',
choices => [qw|blue red green skjdfh lksdfj ghls dfkj hs ldfkgh sdflkgjhsdflkgjhsdflkgjs hd
flkfdsjgh lsdkfj ghlsd fkj ghlsd fkjg hlsdfk jg hdfs lkj ghs dlfkgj|],
default => 'hs',
auto_columns => 1,
);
print "\nYou have selected $reply\n\n";
# With new param 'columns' - determine fixed column to list choices
$reply = $term->get_reply(
prompt => 'What is your favourite selection?',
print_me => 'List of choices:',
choices => [qw|blue red green skjdfh lksdfj ghls dfkj hs ldfkgh sd flkg jhsdf lkgjhs dflkgjs hd
flkfdsjgh lsdkfj ghlsd fkj ghlsd fkjg hlsdfk jg hdfs lkj ghs dlfkgj|],
default => 'hs',
columns => 3,
);
print "\nYou have selected $reply\n\n";
#------------------------------------------------------------------------------------------------------
package Term::UI;
use Term::ReadKey;
sub get_reply {
my $term = shift;
my %hash = @_;
my $tmpl = {
default => { default => undef, strict_type => 1 },
prompt => { default => '', strict_type => 1, required => 1 },
choices => { default => [], strict_type => 1 },
multi => { default => 0, allow => [0, 1] },
allow => { default => qr/.*/ },
print_me => { default => '', strict_type => 1 },
columns => { default => 1, strict_type => 1 },
auto_columns =>{ default => 0, allow => [0, 1] },
};
my $args = check( $tmpl, \%hash, $VERBOSE )
or ( carp( loc(q[Could not parse arguments]) ), return );
### add this to the prompt to indicate the default
### answer to the question if there is one.
my $prompt_add;
### if you supplied several choices to pick from,
### we'll print them separately before the prompt
if( @{$args->{choices}} ) {
my $i;
my($screen_width) = GetTerminalSize();
my $column_width = int($screen_width / $args->{columns});
### formatted choice to construct multicolumn printing
my $max_choice_length = 0;
for my $choice ( @{$args->{choices}} ) {
$i++; # the answer counter -- but humans start counting
# at 1 :D
### so this choice is the default? add it to 'prompt_add'
### so we can construct a "foo? [DIGIT]" type prompt
$prompt_add = $i if (defined $args->{default} and $choice eq $args->{default});
### Max lenght of choices (to detemine auto columns)
if(length $choice > $max_choice_length){
$max_choice_length = length $choice;
}
}
my $format_index = '%3s> ';
my $index_width = 5;
### detemine auto columns
if( $args->{auto_columns} ) {
my $columns = int($screen_width / ($max_choice_length + $index_width) );
$args->{columns} = $columns || 1;
}
### determine column width
my $width_choice = int($screen_width / $args->{columns}) - $index_width;
my $format_column = "${format_index}%-${width_choice}s";
### list choices
$i = 0;
for my $choice ( @{$args->{choices}} ) {
$i++; # the answer counter
my $break = $i == 1 || !($i % $args->{columns}) ? "\n" : '';
### create a "DIGIT> choice" type column
$args->{print_me} .= $break . sprintf $format_column, $i, $choice;
}
### we listed some choices -- add another newline for
### pretty printing
$args->{print_me} .= "\n" if $i;
### allowable answers are now equal to the choices listed
$args->{allow} = $args->{choices};
### no choices, but a default? set 'prompt_add' to the default
### to construct a 'foo? [DEFAULT]' type prompt
} elsif ( defined $args->{default} ) {
$prompt_add = $args->{default};
}
delete $args->{columns};
delete $args->{auto_columns};
### we set up the defaults, prompts etc, dispatch to the readline call
return $term->_tt_readline( %$args, prompt_add => $prompt_add );
}
#------------------------------------------------------------------------------------------------------