#!/usr/bin/env perl -l

use strict;
use warnings;

use Tk;

print 'Do something before GUI.';

print 'Hit <Enter> to start GUI: ';
(undef) = scalar <>;

my $choice;

run_gui(\$choice);

print 'Your choice: ', defined $choice ? $choice : 'nothing';

print 'Do something after GUI.';


sub run_gui {
    my $choice = shift;

    my $mw = MainWindow::->new();

    my @choices = qw{A B C D};
    my $chosen;
    my $tl;

    $mw->Button(-text => 'Make Choice', -command => sub {
        make_choice(\$mw, \$tl, \@choices, \$chosen);
    })->pack();
    $mw->Button(-text => 'Show Choice', -command => sub {
        if (defined $chosen) {
            print "You chose: $chosen";
        }
        else {
            print "Nothing chosen yet!";
        }
    })->pack();
    $mw->Button(-text => 'Exit', -command => sub { $mw->destroy })->pack();

    MainLoop;

    $$choice = $chosen;
}

sub make_choice {
    my ($parent, $tl, $choices, $chosen) = @_;

    if (! Exists($$tl)) {
        $$tl = $$parent->Toplevel();
        my $lb = $$tl->Scrolled('Listbox',
            -selectmode => 'single',
            -scrollbars => 'osoe',
        )->pack();
        $lb->insert(end => @$choices);

        $$tl->Button(-text => 'Done', -command => sub {
            my $selection = $lb->curselection();

            if (ref $selection) {
                $$chosen = $choices->[$selection->[0]];
            }

            $$tl->grabRelease();
            $$tl->withdraw();
        })->pack();
    }
    else {
        $$tl->deiconify();
        $$tl->raise();
    }

    $$tl->grab();
}