Perl Tk DialogBox with custom buttons and widgets

---

examples/tk/dialog_box.pl

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;
    }
}

examples/tk/color_selector_dialog_box.pl

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;
    #}
}

examples/tk/popout.pl

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;
}