#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;

# works on Windows as far as my limited testing goes

my $data = shift || 'date';  #sample code to pass to thread

my %shash;
#share(%shash); #will work only for first level keys
my %hash;
my %workers;
my $numworkers = 3;

foreach my $dthread(1..$numworkers){
 share ($shash{$dthread}{'go'});
 share ($shash{$dthread}{'progress'});
 share ($shash{$dthread}{'timekey'});  #actual instance of the thread
 share ($shash{$dthread}{'frame_open'}); #open or close the frame
 share ($shash{$dthread}{'handle'});
 share ($shash{$dthread}{'data'});
 share ($shash{$dthread}{'pid'});
 share ($shash{$dthread}{'die'});
 
 $shash{$dthread}{'go'} = 0;
 $shash{$dthread}{'progress'} = 0;
 $shash{$dthread}{'timekey'} = 0;
 $shash{$dthread}{'frame_open'} = 0; 
 $shash{$dthread}{'handle'} = 0;
 $shash{$dthread}{'data'} = $data;
 $shash{$dthread}{'pid'} = -1;
 $shash{$dthread}{'die'} = 0;
 $hash{$dthread}{'thread'} = threads->new(\&work,$dthread);
}


use Tk;
use Tk::Dialog;

my $mw = MainWindow->new(-background => 'gray50');

my $lframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
                  ->pack(-side =>'left' ,-fill=>'y');
my $rframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
                  ->pack(-side =>'right',-fill =>'both' );

my %actives = ();   #hash to hold reusable numbered widgets used for downloads
my @ready = ();     #array to hold markers indicating activity is needed

#make 3 reusable downloader widget sets-------------------------
foreach(1..$numworkers){
   push @ready, $_;
#frames to hold indicator
$actives{$_}{'frame'} = $rframe->Frame( -background => 'gray50' );

$actives{$_}{'stopbut'} = $actives{$_}{'frame'}->Button(
        -text       => "Stop Worker $_",
        -background => 'lightyellow',
        -command    => sub {  } )->pack( -side => 'left', -padx => 10 );

$actives{$_}{'label1'} = $actives{$_}{'frame'} ->Label(
         -width       => 3,
	 -background => 'black',
	 -foreground => 'lightgreen',
         -textvariable => \$shash{$_}{'progress'},
    )->pack( -side => 'left' );

$actives{$_}{'label2'} = $actives{$_}{'frame'} ->Label(
         -width       => 1,
         -text        => '%',
	 -background  => 'black',
	 -foreground  => 'lightgreen',
    )->pack( -side => 'left' );


$actives{$_}{'label3'} = $actives{$_}{'frame'} ->Label(
          -text        => '',
	 -background  => 'black',
	 -foreground  => 'skyblue',
    )->pack( -side => 'left',-padx =>10 );

}
#--------------------------------------------------

my $button = $lframe->Button(
    -text       => 'Get a worker',
    -background => 'lightgreen',
    -command    => sub { &get_a_worker(time) } 
           )->pack( -side => 'top', -anchor => 'n', -fill=>'x', -pady => 20 );

my $text = $rframe->Scrolled("Text",
                   -scrollbars => 'ose',
                   -background => 'black',
                   -foreground => 'lightskyblue',
                   )->pack(-side =>'top', -anchor =>'n');

my $repeat;
my $startbut;
my $repeaton = 0;
$startbut = $lframe->Button(
    -text       => 'Start Test Count',
    -background => 'hotpink',
    -command    => sub {
        my $count = 0;
        $startbut->configure( -state => 'disabled' );
        $repeat = $mw->repeat(
            100,
            sub {
                $count++;
                $text->insert( 'end', "$count\n" );
                $text->see('end');
            }
        );
        $repeaton = 1;
    })->pack( -side => 'top',  -fill=>'x', -pady => 20);

my $stoptbut = $lframe->Button(
    -text    => 'Stop Count',
    -command => sub {
        $repeat->cancel;
        $repeaton = 0;
        $startbut->configure( -state => 'normal' );
    })->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20 );

my $exitbut = $lframe->Button(
    -text    => 'Exit',
    -command => sub {
        
        foreach my $dthread(keys %hash){
          $shash{$dthread}{'die'} = 1;
          $hash{$dthread}{'thread'}->join
	 }
        
         if ($repeaton) { $repeat->cancel }
           #foreach ( keys %downloads ) {
           #    #$downloads{$_}{'repeater'}->cancel;
           #}
      # $mw->destroy;	
       exit;
      })->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20 );


#dialog to get file url---------------------
    my $dialog = $mw->Dialog(
        -background => 'lightyellow',
        -title      => 'Get File',
        -buttons    => [ "OK", "Cancel" ]
    );

    my $hostl = $dialog->add(
        'Label',
        -text       => 'Enter File Url',
        -background => 'lightyellow'
    )->pack();

    my $hostd = $dialog->add(
        'Entry',
        -width        => 100,
        -textvariable => '',
        -background   => 'white'
    )->pack();

$dialog->bind( '<Any-Enter>' => sub { $hostd->Tk::focus } );

   my $message = $mw->Dialog(
        -background => 'lightyellow',
        -title      => 'ERROR',
    	-buttons    => [ "OK" ]
    );

  my $messagel = $message->add(
               'Label',
        -text       => '       ',
	-background => 'hotpink'
    )->pack();

$mw->repeat(10, sub{  
   if(scalar @ready == $numworkers){return}
         
   foreach my $set(1..$numworkers){  
     $actives{$set}{'label1'}->
         configure(-text =>\$shash{$set}{'progress'});
       
         if(($shash{$set}{'go'} == 0) and
	    ($shash{$set}{'frame_open'} == 1)) 
	    { 
            my $timekey = $shash{$set}{'timekey'};
           $workers{ $timekey }{'frame'}->packForget; 
	   $shash{$set}{'frame_open'} = 0;    
	   push @ready, $workers{$timekey}{'setnum'}; 			 
	   if((scalar @ready) == 3)
	      {  }
	      $workers{$timekey} = ();
	     delete $workers{$timekey};
           }
        }
    });

$mw->MainLoop;
###################################################################

sub get_a_worker {

   my $timekey = shift;

  $hostd->configure( -textvariable => \$data);
  if ( $dialog->Show() eq 'Cancel' ) { return }

#----------------------------------------------
#get an available frameset
my $setnum; 
  if($setnum = shift @ready){print "setnum->$setnum\n"}
    else{ print "no setnum available\n"; return}

$workers{$timekey}{'setnum'} = $setnum;
$shash{$setnum}{'timekey'} = $timekey;

$workers{$timekey}{'frame'} = $actives{$setnum}{'frame'};
$workers{$timekey}{'frame'}->pack(-side =>'bottom', -fill => 'both' );

$workers{$timekey}{'stopbut'} = $actives{$setnum}{'stopbut'};
$workers{$timekey}{'stopbut'}->configure(
         -command => sub { 
	    $workers{$timekey}{'frame'}->packForget; 
	    $shash{ $workers{$timekey}{'setnum'} }{'go'} = 0;
	    $shash{ $workers{$timekey}{'setnum'} }{'frame_open'} = 0;    
	    push @ready, $workers{$timekey}{'setnum'}; 			 
	    if((scalar @ready) == $numworkers)
	      {  }
	       $workers{$timekey} = ();
	       delete $workers{$timekey};
	    	    });

$workers{$timekey}{'label1'} = $actives{$setnum}{'label1'};
$workers{$timekey}{'label1'}->configure(
              -textvariable => \$shash{$setnum}{'progress'},
	       );

$workers{$timekey}{'label2'} = $actives{$setnum}{'label2'};


$workers{$timekey}{'label3'} = $actives{$setnum}{'label3'};
$workers{$timekey}{'label3'}->configure(-text => $timekey);



$shash{$setnum}{'go'} = 1; 
$shash{$setnum}{'frame_open'} = 1; 
#--------end of get_file sub--------------------------
}

##################################################################
sub work{
  my $dthread = shift;
    $|++; 
    while(1){
       if($shash{$dthread}{'die'} == 1){ goto END }; 
      
       if ( $shash{$dthread}{'go'} == 1 ){

    eval( system( $shash{$dthread}{'data'} )    );

   foreach my $num (1..100){
          $shash{$dthread}{'progress'} = $num; 
       print "\t" x $dthread,"$dthread->$num\n";
       select(undef,undef,undef, .5);
       if($shash{$dthread}{'go'} == 0){last}
       if($shash{$dthread}{'die'} == 1){ goto END }; 
       }
       
    $shash{$dthread}{'go'} = 0; #turn off self before returning      
       }else
         { sleep 1 }
    }
END:
}
#####################################################################