Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Threads-w-Perl/Gtk2 demo

by zentara (Archbishop)
on Jun 28, 2005 at 14:50 UTC ( #470661=snippet: print w/ replies, xml ) Need Help??

Description: 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"
__
}
######################################################################
+#


Comment on Threads-w-Perl/Gtk2 demo
Download Code
Re: Threads-w-Perl/Gtk2 demo
by metaperl (Curate) on Jul 22, 2011 at 14:55 UTC
      Why is the signal blocking of interest to Tk programmers?

      I meant that solely in the context of Tk programmers who want to convert to Gtk2, and run into problems with a single button being used in different contexts, like doing different things depending on what the button text or state is. It just shows the extra depth of the Gtk2 toolkit, a depth beyond what Tk allows.

      Is Tk easier than Perl/gtk?

      Oh yeah, way easier. For example, Gtk2 is hard to set individual widget colors. It can be done, but Tk is way easier.

      `cpan Tk` installed without a single hitch in 32-win strawberry perl whereas perl/gtk required hours of teeth gnashing. wxperl is easy to install on windows too.

      Yes you are right. I found Camelbox: A build of Gtk2-Perl for Windows easy to use for my limited Window's testing, but I have to admit Strawberry is probably a better way to go. Camelbox makes it difficult to add anything to it. WxPerl is usually based on Gtk2, but it is a C++ wrapper aroung the plain C gtk+. I would probably have to say wxperl is probably better if you like the OO style of C++ programming. Me, I like the C style, but don't let my "old dog" ways stop you from wxperl, its just that I'm a functional style programmer. Also, on linux, putting in Gtk2 is easy as pie, and I hate seeing Gtk get a bad wrap just because of a crappy Windows compiler environment.

      do you prefer gtk over wxperl and tk?

      I prefer Tk as number 1, but it has many drawbacks for more advanced work. Gtk2 is way better with threads, as is WxPerl, since it is built on the Gtk2 libraries. Also, many new libraries are emerging like gstreamer, libsoup, and you name your own. Gtk2 and Wxperl are hopping right on those, whearas Tk is left behind. Especially for anything threaded, you would want to use Gtk2 or WxPerl.

      But that said, Tk still fulfill the needs of probably 90% of the problems out there, but it is wise to learn either Wx or Gtk2 to keep up with the new stuff coming out.


      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku ................... flash japh

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://470661]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (11)
As of 2014-08-27 12:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (237 votes), past polls