Threads-w-Perl/Gtk2 demo

[zentara]

Here is a little Gtk2-perl threads demo, with more flash, than the one that comes in the distro demo. :-)

Of interest to Tk programmers, may be the "signal-blocking" needed by Gtk2 buttons. This demonstrates it nicely.

There is also a "hard-2-find" trick for setting the cursor color in a textbox.

#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;
use Glib qw/TRUE FALSE/;
use Gtk2 '-init';

my $data = shift || 0;

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

foreach my $dthread(1..$numworkers){
  share ($shash{$dthread}{'go'});
  share ($shash{$dthread}{'data'});
  share ($shash{$dthread}{'die'});

  $shash{$dthread}{'go'} = 0;
  $shash{$dthread}{'data'} = $data;
  $shash{$dthread}{'die'} = 0;

  $thash{$dthread}{'thread'} = threads->new(\&work,$dthread);
  $thash{$dthread}{'button'} = undef;    #thread start/stop button 
  $thash{$dthread}{'lconnect'} = undef;  #used in signal blocking 
  $thash{$dthread}{'sconnect'} = undef;  #used in signal blocking 
}

#set the desired style 
set_style();

my $window = Gtk2::Window->new('toplevel');
$window->set_title('Z Multi-threads-w-ProgressBars');
$window ->signal_connect( 'destroy' => \&exit_thr );
$window->set_border_width(10);
$window->set_size_request(400,400);

my $vbox = Gtk2::VBox->new( FALSE, 6 );
$window->add($vbox);
$vbox->set_border_width(2);

my $hbox= Gtk2::HBox->new( FALSE, 6 );
my $hbox1 = Gtk2::HBox->new( FALSE, 6 );
$vbox->pack_end($hbox,FALSE,FALSE,0);
$vbox->pack_end (Gtk2::HSeparator->new, FALSE, FALSE, 0);
$vbox->pack_end($hbox1,FALSE,FALSE,0);
$hbox->set_border_width(2);
$vbox->pack_end (Gtk2::HSeparator->new, FALSE, FALSE, 0);

my $ebutton = Gtk2::Button->new_from_stock('gtk-quit');
$hbox->pack_end( $ebutton, FALSE, FALSE, 0 );
$ebutton->signal_connect( clicked => \&exit_thr );

foreach my $dthread(1..$numworkers){
 $pbar{$dthread}{'bar'} = Gtk2::ProgressBar->new();
 $pbar{$dthread}{'bar'}->set_text('T'.$dthread.'->');
 $hbox->pack_start($pbar{$dthread}{'bar'},1,1,0);
}
###################################################### 
#make buttons 
foreach my $dthread(1..$numworkers){
 $thash{$dthread}{'button'} = Gtk2::Button->new_with_label('Run T'.$dt
+hread);
 $hbox1->pack_start($thash{$dthread}{'button'} , 1, 1, 0 );
 $thash{$dthread}{'lconnect'} = $thash{$dthread}{'button'}
                        ->signal_connect( clicked => sub{ launch($dthr
+ead) });
}

#make text display area################################### 
# Create a textbuffer to contain that string  
my $textbuffer = Gtk2::TextBuffer->new();
$textbuffer->set_text("Thread Output\n");

# Create a textview using that textbuffer  
my $textview = Gtk2::TextView->new_with_buffer($textbuffer);

# Add the textview to a scrolledwindow  
my $scrolledwindow = Gtk2::ScrolledWindow->new( undef, undef );
$scrolledwindow->add($textview);
$vbox->pack_start($scrolledwindow, 1, 1, 0 );

my $end_mark = $textbuffer->create_mark( 'end', $textbuffer->get_end_i
+ter, FALSE );
# every time we insert text, scroll to that mark. 
$textbuffer->signal_connect(
    insert_text => sub {
        $textview->scroll_to_mark( $end_mark, 0.0, TRUE, 0.0, 1.0 );
    }
);


$window->show_all();
foreach my $dthread(1..$numworkers){
$pbar{$dthread}{'bar'}->hide;   #needs to be called after show_all 
}

Gtk2->main;

##################################### 
sub delete_event {
Gtk2->main_quit;
return FALSE;
}
####################################### 
sub launch{
   my $dthread = shift;
   $pbar{$dthread}{'bar'}->show;
   $thash{$dthread}{'button'}->set_label('Stop T'.$dthread);
   $thash{$dthread}{'button'}->signal_handler_block( $thash{$dthread}{
+'lconnect'} );
   $thash{$dthread}{'sconnect'} =
     $thash{$dthread}{'button'}->signal_connect( clicked => sub{ stop(
+ $dthread ) });
   $shash{$dthread}{'go'} = 1;

   Glib::Timeout->add (100,
         sub {
            if($shash{$dthread}{'go'} == 1){
                 my $spacer = "\t\t" x ($dthread-1).$dthread.'->';
#                my $spacer = "\t" x $dthread; 
                 $pbar{$dthread}{'bar'}->
                    set_text('Thread'.$dthread.'->'.$shash{$dthread}{'
+data'});
                 $pbar{$dthread}{'bar'}->
                    set_fraction($shash{$dthread}{'data'}/100);
                 $textbuffer->insert(
                     $textbuffer->get_end_iter, "$spacer $shash{$dthre
+ad}{'data'}\n" );
                 if( $shash{$dthread}{'data'} == 100 ){ stop($dthread)
+; return FALSE; }
                 return TRUE;
               }else{
                return FALSE;
              }

          }
        );
}
################################################## 
sub stop{
   my $dthread = shift;
   $pbar{$dthread}{'bar'}->hide;
   $shash{$dthread}{'go'} = 0;
   $shash{$dthread}{'data'} = 0;
   $thash{$dthread}{'button'}->set_label('Run T'.$dthread);
   $thash{$dthread}{'button'}->
         signal_handler_block ($thash{$dthread}{'sconnect'});
   $thash{$dthread}{'button'}->
         signal_handler_unblock ($thash{$dthread}{'lconnect'});
}
######################################################### 
sub work{
    my $dthread = shift;
    $|++;
    while(1){
       if($shash{$dthread}{'die'} == 1){ goto END };

       if ( $shash{$dthread}{'go'} == 1 ){

         foreach my $num (1..100){
            $shash{$dthread}{'data'} = $num;
            select(undef,undef,undef, .3);
            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:
}
##################################################################### 
sub exit_thr{

foreach my $dthread(1..$numworkers){
  $shash{$dthread}{'die'} = 1;
  $thash{$dthread}{'thread'}->join;
}

  Gtk2->main_quit;
  return FALSE;
}
######################################################################
+## 
sub set_style{
Gtk2::Rc->parse_string(<<__);

style "normal" {
font_name ="serif 12"
}

style "my_text" {
font_name ="sans 24"
text[NORMAL] = "#FFAA00"
base[NORMAL] = "#000000"
GtkTextView::cursor-color = "red"
}

widget "*" style "normal"
widget "*Text*" style "my_text"
__
}
######################################################################
+#