187 lines
4.1 KiB
Perl
187 lines
4.1 KiB
Perl
package TUI;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use diagnostics;
|
|
|
|
use Curses;
|
|
use Curses::UI;
|
|
use Curses::UI::Common;
|
|
|
|
# Singleton
|
|
my $_cui;
|
|
|
|
sub init_cui {
|
|
if ( !defined $_cui ) {
|
|
$_cui = new Curses::UI(
|
|
-color_support => 1,
|
|
-mouse_support => 1,
|
|
|
|
# -clear_on_exit => 1,
|
|
);
|
|
}
|
|
|
|
return $_cui;
|
|
}
|
|
|
|
sub select_from_list {
|
|
my ( $title, $multiselect, @items ) = @_;
|
|
|
|
# Optional item descriptions: { item => "description" }
|
|
my $descriptions =
|
|
( @items && ref( $items[-1] ) eq 'HASH' ) ? pop @items : {};
|
|
|
|
die "No items to choose from" unless @items;
|
|
|
|
# Width of the longest item name to align descriptions
|
|
my $width = 0;
|
|
for my $item (@items) {
|
|
$width = length $item if length $item > $width;
|
|
}
|
|
|
|
my $format = sub {
|
|
my ($item) = @_;
|
|
my $desc = $descriptions->{$item};
|
|
return $item unless defined $desc && length $desc;
|
|
return sprintf( "%-*s %s", $width, $item, $desc );
|
|
};
|
|
|
|
my @values = $multiselect ? ( '__ALL__', @items ) : @items;
|
|
my %labels =
|
|
$multiselect
|
|
? ( '__ALL__' => '[ALL]', map { $_ => $format->($_) } @items, )
|
|
: map { $_ => $format->($_) } @items;
|
|
|
|
my @selection;
|
|
my @selection_order; # multiselect only: items in toggle order
|
|
|
|
my $cui = init_cui();
|
|
my $win = $cui->add( 'root', 'Window', );
|
|
|
|
my $listbox;
|
|
$listbox = $win->add(
|
|
'item_list',
|
|
'Listbox',
|
|
-title => $title,
|
|
-border => 1,
|
|
-values => \@values,
|
|
-labels => \%labels,
|
|
-multi => $multiselect == 1,
|
|
-radio => $multiselect == 0,
|
|
-padbottom => 1,
|
|
-onchange => sub {
|
|
return unless $multiselect;
|
|
my %now = map { $_ => 1 } $listbox->get();
|
|
|
|
# Append newly selected items in toggle order
|
|
for my $item (@items) {
|
|
if ( $now{$item} && !grep { $_ eq $item } @selection_order ) {
|
|
push @selection_order, $item;
|
|
}
|
|
}
|
|
|
|
# Drop deselected items
|
|
@selection_order = grep { $now{$_} } @selection_order;
|
|
},
|
|
);
|
|
|
|
$win->add(
|
|
'info', 'Label',
|
|
-y => -1,
|
|
-text => "Space/Enter = toggle, C = confirm, Q = quit",
|
|
);
|
|
|
|
$listbox->clear_binding('loose-focus');
|
|
|
|
$listbox->set_binding(
|
|
sub {
|
|
my @picked = $listbox->get();
|
|
if ( $multiselect && grep { $_ eq '__ALL__' } @picked ) {
|
|
@selection = @items;
|
|
}
|
|
elsif ($multiselect) {
|
|
@selection = @selection_order;
|
|
}
|
|
else {
|
|
@selection = @picked;
|
|
}
|
|
$cui->mainloopExit();
|
|
},
|
|
'c',
|
|
);
|
|
|
|
$listbox->set_binding(
|
|
sub {
|
|
@selection = ();
|
|
$cui->mainloopExit();
|
|
},
|
|
'q',
|
|
);
|
|
|
|
$listbox->focus();
|
|
$cui->mainloop();
|
|
|
|
$cui->leave_curses();
|
|
$cui->delete('root');
|
|
|
|
return @selection;
|
|
}
|
|
|
|
# Returns the entered string or undef when cancelled
|
|
sub read_string {
|
|
my ( $title, $default ) = @_;
|
|
|
|
my $value;
|
|
|
|
my $cui = init_cui();
|
|
my $win = $cui->add( 'root', 'Window', );
|
|
|
|
my $entry;
|
|
$entry = $win->add(
|
|
'string_entry',
|
|
'TextEntry',
|
|
-title => $title,
|
|
-border => 1,
|
|
-text => ( defined $default ? $default : '' ),
|
|
);
|
|
|
|
$win->add(
|
|
'info', 'Label',
|
|
-y => -1,
|
|
-text => "Enter = confirm, Esc = cancel",
|
|
);
|
|
|
|
# Set cursor to the end
|
|
$entry->pos( length $entry->get() );
|
|
|
|
# Enter would otherwise just leave the entry
|
|
$entry->clear_binding('loose-focus');
|
|
|
|
$entry->set_binding(
|
|
sub {
|
|
$value = $entry->get();
|
|
$value =~ s/^\s+|\s+$//g;
|
|
$cui->mainloopExit();
|
|
},
|
|
KEY_ENTER(),
|
|
);
|
|
|
|
$entry->set_binding(
|
|
sub {
|
|
$value = undef;
|
|
$cui->mainloopExit();
|
|
},
|
|
CUI_ESCAPE(),
|
|
);
|
|
|
|
$entry->focus();
|
|
$cui->mainloop();
|
|
|
|
$cui->leave_curses();
|
|
$cui->delete('root');
|
|
|
|
return $value;
|
|
}
|
|
|
|
1;
|