use strict;
use warnings;
use 5.010;
use Tk;
use Tk::DialogBox;
my $top = MainWindow->new;
my $btn = $top->Button(
-text => 'Click me',
-font => ['fixed', 20],
-command => \&do_on_click,
);
$btn->pack;
MainLoop;
sub set_color {
my ($dialog, $color) = @_;
say $color;
$btn->configure(-background => $color);
$dialog->Exit();
}
sub do_on_click {
my $dialog = $top->DialogBox(
-title => 'Versions',
-popover => $top,
-buttons => ['Yes', 'No', 'Cancel', 'Redo'],
);
$dialog->add("Label", -background => 'yellow', -text => 'Just some yellow text', -font => ['fixed', 20])->pack();
my $entry = $dialog->add("Entry", -font => ['fixed', 20],)->pack();
my $res = $dialog->Show;
if ($res) {
say $res;
say $entry->get;
}
}
use strict;
use warnings;
use 5.010;
use Tk;
use Tk::DialogBox;
my $top = MainWindow->new;
my $btn = $top->Button(
-text => 'Click me',
-font => ['fixed', 20],
-command => \&do_on_click,
);
$btn->pack;
MainLoop;
sub set_color {
my ($dialog, $color) = @_;
say $color;
$btn->configure(-background => $color);
$dialog->Exit();
}
sub do_on_click {
my $dialog = $top->DialogBox(
-title => 'Versions',
-popover => $top,
-buttons => ['Cancel'],
);
my @colors = qw(red green blue yellow);
for my $color (@colors) {
$dialog->add("Button", -background => $color, -command => [\&set_color, $dialog, $color])->pack();
}
my $res = $dialog->Show;
#if ($res) {
# say $res;
#}
}
use strict;
use warnings;
use 5.010;
use Tk;
my $top = MainWindow->new;
my $btn = $top->Button(
-text => 'Click me',
-font => ['fixed', 20],
-command => \&do_on_click,
);
$btn->pack;
my $pop;
MainLoop;
sub do_on_click {
print("Clicked\n");
if (not $pop) {
say 'Creating';
$pop = $top->Toplevel();
$pop->Frame(-width => 150, -height => 230)->pack;
$pop->protocol('WM_DELETE_WINDOW' => [\&picked, $pop, undef]);
#$pop->overrideredirect(1);
my @colors = qw(blue red yellow);
for my $color (@colors) {
my $btn = $pop->Button(
-font => ['fixed', 20],
-command => [\&picked, $pop, $color],
-width => 20,
-bg => $color,
);
$btn->pack;
}
}
$pop->Popup(-popanchor => 'c', -overanchor => 'c', -popover => $top);
}
# TODO: modal (so I cannot click on the main window as long as this is here)
sub picked {
my ($pop, $color) = @_;
if ($color) {
say $color;
$btn->configure(-background => $color);
}
$pop->withdraw;
}