#!perl -slw
use strict;
use threads;
use threads::shared;
use Thread::Queue;

## A shared var to communicate progess between work thread and TK
my $Q = new Thread::Queue;
my $pid:shared;

sub work{

	if( $^O eq "linux" )
	{
		$pid = open PROC,
		"-|",
		"perl",
		"-le",
		'$|=1; print and select(undef,undef,undef,0.1) for 1 .. 1000'
			or die $!;
	}
	elsif( $^O eq "MSWin32" )
	{
		$pid = open PROC,
    'perl -le"$|=1; print and select(undef,undef,undef,0.1) for 1 .. 1000" |'
		or die $!;
	}
	else
	{
		die "Not implemented for $^O";
	}

	if( $pid ) {
		while( <PROC> ) {
			$Q->enqueue( $_ );
		}
		close PROC;
	}
}

threads->new( \&work )->detach;

## For lowest memory consumption require (not use)
## Tk::* after you've started the work thread.
use Tk;
use Tk::ProgressBar;

my $mw = MainWindow->new;
my $pb = $mw->ProgressBar()->pack();

my $repeat;
$repeat = $mw->repeat( 100 => sub {
	while( $Q->pending ) {
		my $progress = $Q->dequeue;
		return unless $progress;
    	$repeat->cancel if $progress == 100;
    	$pb->value( $progress )
    }
} );

$mw->Button('-text' => 'Cancel',
			'-command' => sub{ kill 9, $pid })->pack();

$mw->MainLoop;