#! /usr/bin/perl
use strict;
use warnings;

use Tk;

{   my $in;
    sub stop { undef $in }

    sub run {
        my ($type, $entry) = @_;
        my $command = $entry->cget('-text');
        if (1 == $type) {
            my $out = $_[2];
            open $in, '-|', $command or die $!;
            my $repeat;
            $repeat = ($entry->repeat(1, sub {
                return $entry->afterCancel($repeat)
                    if $repeat && ! defined $in;

                read $in, my $buff, 100;
                if (length $buff) {
                    $out->insert(end => $buff);
                    $out->yview('end');
                }
            }));
        } elsif (2 == $type) {
            system "$command&";
        }
    }
}

my $mw = MainWindow->new(-title => 'Two background processes');
my $le_read_from = $mw->LabEntry(-label     => 'Read from:',
                                 -labelPack => [qw[ -side left ]],
                                 -text      => 'find')->pack;
my $le_process = $mw->LabEntry(-label     => 'Run in the background:',
                               -labelPack => [qw[ -side left ]],
                               -text      => 'xterm')->pack;

my $out;
my $f_b = $mw->Frame->pack;
my $b_run1 = $f_b->Button(-text    => 'Run 1',
                          -command => sub { run(1, $le_read_from, $out) })
    ->pack(-side => 'left');
my $b_run2 = $f_b->Button(-text    => 'Run 2',
                          -command => [\&run, 2, $le_process])
    ->pack;
my $f_b2 = $mw->Frame->pack;
my $b_clear1 = $f_b2->Button(-text    => 'Clear',
                             -command => sub { $out->delete('0.0', 'end') })
    ->pack(-side => 'left');
my $b_stop = $f_b2->Button(-text    => 'Stop',
                           -command => \&stop)->pack(-side => 'left');
my $b_quit = $f_b2->Button(-text    => 'Quit',
                           -command => sub { Tk::exit })->pack;

my $playground = $mw->Text->pack;
$playground->insert('0.0',
    "You can type any text here to check the interactivity.\n");

$out = $mw->ROText->pack;

MainLoop();