Gtk2 ....needs thread testing on a multi-threaded computer

zentara has asked for the wisdom of the Perl Monks concerning the following question:

UPDATE Apr 03, 2012 ... this code is horribly broken. It's ugliness rears it's head on a true multi-cpu computer. The biggest problem is I'm trying to lock individual elements of a container hash. The perldoc explicitly warns against this. I will try to post a working version as soon as I can figure it out. :-)

Second UPDATE Apr 03, 2012: fixed code: See Re: Gtk2 ....needs thread testing on a multi-threaded computer below.

.... hi, the code below was originally to be posted in CUFP, but there was some kind of perlmonk related error, and i couldn't post.... then it dawned on me, that this might be questionable code on true multi-cpu systems.... i only have a cheap single cpu laptop....so would any of you care to run it on your machines and see how the finish logic works.....like how many dead heats do you see, or other malfunctions.....it works fine here

... the base64 encoded section is an animated gif, which i need to write to file, so the poor gtk2 loader can handle it..... it can only load disk files.....so i need to write it out.....but you can bypass that if you are scared of the animated gif, and substitute your own

i envision it being used to see who pays for lunch

:-)

UPDATE: added locking on all shared variables

....thanks to anyone who tests this

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

# apparently the &delete_event sub needs this to exit without GLib err
+ors
# it depends where you create the thread
# ...i'm creating it well down in the Gtk2 code
Glib::Object->set_threadsafe (1);

use Gtk2 qw/-init -threads-init/;

# usage: ./scriptname number_horses

# the animated gif support in Gtk2 is a bit limited, and
# it will only load from a disk file..... so i include
# the base64 encoded image at the bottom, and write it to
# disk, if not already done 

if( ! -e './horse.gif' ){
     open (FH, '>', 'horse.gif') or die "$!\n";
     print FH  get_horsey();
     close FH;
  }

my $numworkers = shift || 6;
my %track;

share my $finish;
$finish = 0;

foreach my $tr(1..$numworkers){
 share ($track{$tr}{'go'});
 share ($track{$tr}{'die'});
 share ($track{$tr}{'tot'});

 $track{$tr}{'go'} = 0;
 $track{$tr}{'die'} = 0;
 $track{$tr}{'tot'} = 0;
}


my $window = Gtk2::Window->new;
$window->signal_connect('destroy', \&delete_event);
$window->set( border_width => 15 );
$window->set_size_request(800,600);

my $vbox0   = Gtk2::VBox->new(0,0);
$window->add($vbox0);

my $hbox = Gtk2::HBox->new( 0, 6 );
$hbox->set_size_request(5,50);
$vbox0->pack_start($hbox,0,0,0); 

my $sbutton = Gtk2::Button->new(' Start ');
$sbutton->signal_connect( "clicked" => \&restart ); 

# connect the 'clicked' signal of the button to our callback
my $sconnect = $sbutton->signal_connect( "clicked" => \&start );
$hbox->pack_start($sbutton,0,0,0);

my $lab = Gtk2::Label->new();
       $lab->set_markup("<span foreground=\"lightseagreen\" background
+=\"black\"
         size=\"15000\">Race to 500</span>");
$hbox->pack_start($lab,0,0,0);


my $ebutton = Gtk2::Button->new('Exit');
$ebutton->signal_connect( "clicked" => \&delete_event );
$hbox->pack_end($ebutton,0,0,0);

my $winlab = Gtk2::Label->new();
       $winlab->set_markup("<span foreground=\"lightseagreen\" backgro
+und=\"black\"
         size=\"20000\">:Winner</span>");
$hbox->pack_end($winlab,0,0,0);

my $wins = Gtk2::Label->new();
       $wins->set_markup("<span foreground=\"lightseagreen\" backgroun
+d=\"black\"
         size=\"20000\"> ? </span>");
$hbox->pack_end($wins,0,0,0);


my $pba = Gtk2::Gdk::PixbufAnimation->new_from_file ('horse.gif');
my  $static = $pba->get_static_image;
my $vbox   = Gtk2::VBox->new();
    
my $sw = Gtk2::ScrolledWindow->new (undef, undef);
$sw->set_shadow_type ('etched-out');
$sw->set_policy ('automatic', 'automatic');
$sw->set_size_request (500, 500);
$sw->set_border_width(5);
$vbox0->pack_start($sw,1,1,0);
$sw->add_with_viewport($vbox);

foreach my $tr (1..$numworkers){
 
  $track{$tr}{'image'} = Gtk2::Image->new_from_animation ($pba);

  $track{$tr}{'trak'} = Gtk2::Frame->new($tr);
  $vbox->pack_start( $track{$tr}{'trak'}, 0, 0, 0 );
  $track{$tr}{'trak'}->set_border_width(3);
   
  $track{$tr}{'hbox'} = Gtk2::HBox->new( 0, 6 );
  $track{$tr}{'hbox'}->set_size_request(5,50);
  $track{$tr}{'trak'}->add( $track{$tr}{'hbox'} );
  
  $track{$tr}{'hbox'}->pack_start( $track{$tr}{'image'}, 0, 0, 0 );


  $track{$tr}{'score'} = Gtk2::Label->new();
       $track{$tr}{'score'}->set_markup("<span foreground=\"black\" 
         size=\"20000\">$tr</span>");

  $track{$tr}{'hbox'}->pack_end( $track{$tr}{'score'}, 0, 0, 0 );

  $track{$tr}{'thread'} = threads->new(\&work,$tr,$wins);
}

$window->show_all();

$winlab->hide;
$wins->hide;

Gtk2->main;


sub start{
   $finish = 0;
   $sbutton->set_label('Restart');
   $sbutton->signal_connect( "clicked" => \&restart ); 

 # randomized start out of the box first
 my @shuffled = map {$_->[0]}
               sort { $a->[1] <=> $b->[1]}
               map {[$_, rand(1)]} (1..$numworkers);

  foreach my $tr (@shuffled){
      lock $track{$tr}{'go'};  #added as test fix
      $track{$tr}{'go'} = 1;
  }

}

sub restart{
   $finish = 1;

  foreach my $tr (1..$numworkers){
   lock $track{$tr}{'go'}; #added as test fix
   $track{$tr}{'go'} = 0;
   lock $track{$tr}{'die'}; #added as test fix
   $track{$tr}{'tot'} = 0;
   
   $track{$tr}{'hbox'}->set_child_packing ($track{$tr}{'image'}, 0, 0,
+ 0 , 'start');
   $track{$tr}{'score'}->set_markup("<span foreground=\"black\"  
            size=\"20000\">0</span>");
  
   $track{$tr}{'score'}->set_markup("<span foreground=\"black\"  
                    size=\"20000\">0</span>");
  }

   $sbutton->set_label(' Start ');
   $sbutton->signal_connect( "clicked" => \&start ); 

   $winlab->hide;
   $wins->hide;

}

sub delete_event{

  foreach my $tr (1..$numworkers){
      lock $track{$tr}{'go'}; #added as test fix
      $track{$tr}{'go'} = 0;
      lock $track{$tr}{'die'}; #added as test fix 
      $track{$tr}{'die'} = 1;
      $track{$tr}{'thread'}->join;
  }
  Gtk2->main_quit;
  return 0;
} 


sub work{
  my ($tr, $wins ) = @_;
  $|++; 

    while(1){
       if($track{$tr}{'die'} == 1){ return }; 

         if ( $track{$tr}{'go'} == 1 ){

           while(1) {
                my $whip = 2 - rand (1); 
           
           lock $track{$tr}{'tot'};
           $track{$tr}{'tot'} += (rand 5) + $whip; 
           
    
        if ( $finish == 0){                                 
         
                 Glib::Idle->add(
               sub{
                        
                my $tot = sprintf('%.2f', $track{$tr}{'tot'} );
                $track{$tr}{'hbox'}->set_child_packing ($track{$tr}{'i
+mage'}, 0, 0,$tot , 'start');
        
                    $track{$tr}{'score'}->set_markup("<span foreground
+=\"black\"  
                    size=\"20000\">$tot</span>");
                
                   #check for winner                  
                   if($track{$tr}{'tot'} > 500){ 
                    lock($finish); # prevent thread races :-)
                    $finish = 1; 
                    $track{$tr}{'score'}->set_markup("<span foreground
+=\"red\"  
                    size=\"20000\">$tot</span>");
                   
                    $wins->set_markup("<span foreground=\"red\"  
                    size=\"25000\">$tr</span>");
            $wins->show;
            $winlab->show;
                                 
                     }
                   });
             }
      
      if($track{$tr}{'die'} == 1){ return };
      if ( $track{$tr}{'go'} == 0 ){last }        
  
      select(undef,undef,undef,.1);                
      
   }     
# end of go loop      
       }else
         { select (undef,undef,undef,.1) } #sleep while loop
   
   } #end of main while loop

}

sub get_horsey{

return decode_base64(
'R0lGODlhMgAwAMQbAAAAAAAIABgYGBhzGBitGDEAWjExSkpKa0qU/2NCIWtrhHtSKXtaW
+oyMlKVr
OcbGzs6EWs6cnN6EY+9zAO+ca/cA9/+tGP+te/+9c//nGP///wAAAAAAAAAAAAAAAAAAAC
+H/C05F
VFNDQVBFMi4wAwEAAAAh/jVCdWlsdCBieSBCbG9veiAtIGh0dHA6Ly9wZXJzby5jbHViLW
+ludGVy
bmV0LmZyL2xhYmdpYwAh+QQJCgAbACwEAAMALQAsAAAF/uAmjmRplkEanGzrmoGhKMb63r
+gYzLSd
/6wdzQAAGmG8WfF4UxwmlqgFkKKmRAuHg3l6HDJgsOVR0BQKIseF4mBzRwrNwSLOTDSQc6
+ENoVwS
EA4JLA4QNw0aDVAWE3YKDxgYEJMUEAkUCxQUgySFfC8HDxoPE6V2Gw2UmgmsEAusJRBrbB
+KGLQYN
ogoCjRMbmhcSrAkPCbkNnCMLlBd9ky0HuQ+KGYx9rFoQ0w8OEn8lC8uafZVbJ9EPpGETkn
+0SFLkQ
AvPJyqqzlSwHjw1SExQY/ARz8ACCBgEIhJkoBMHbhVmCtNSbd6CVBEQP3gXKFUHDpW8lEh
+TSxCZc
w2YO/gaobHBAQCGHokaJpFBsprd6WMaFA+StnEoBDQQsU1UpZkFtlSbdHJFgqIOdC3pOSj
+lAQEue
zZIuMxqPoYB6UEWIxDfpp4ABmchNfbohQQBdHgt9dSHS4TgCVVlGVRXolYkE9CzRJfewFg
+G88/io
8nsCkEucIfs81ET18IBu5ZwtaAEIMjhZfmoJUqmyTTnTm9+0lbwm0DBsUkemfpMFWCVAJA
+NJnupK
NbbQk7KQwzTcteccTbV4cyaSoaXiEgRx4ZmUnIOvw57iHhf9+Avc7tZcn4d958harWEBmV
+komLx5
IugBFjnpZLNJ3hvLag6YBXlWwjU0jnQ3BDDTJv29gFBeOOetMRtnQqmRX2OvNScRXfN1xg
+Q2nDDQ
EQMsiARLU4IdkdwgHn5YAgMMDMNUiSZ2xuKMJHjYYj38TbfMcSyqR4KIbyTAYowRvMFiBC
+ACIQAD
GkQQwDxPPilAlFBOKUCNQ+YgZYrkdenll1MCISWYZJbZpZJmpumlamqSeUMIACH5BAkKAB
+sALAQA
AgAtAC0AAAX+4CaOZGmWQRqcbOuagaEoxvreuBjMtJ3/rB3NAAAaYbxZ8XhTHCxQKCA1TQ
+EdEIhD
tD09DplwePIoaAqFI0RCoWQpJoXmGbZkJhoIOr1xLCAbCydYWW8XFBJrJQ0aDRNQE3cKDx
+gYWg4S
F1oXXSUObZprF4dZJAcPcxOqdxsNpZgQbQmxCSexoG0UF4kkBg2oBgKREyNYmbIXCbIsxo
+egvCMH
vw0HAhkWEw7GEAsLCcretS5YuG4l0g/UYhNu3doPCdPiL8a5JugKqqqVWWzpD5iSvUigzZ
+g3bfMC
CDjwTVuDBpl2/YIgoOI8F98OInKTYMAAagK0raHw4EEbLQ/+IGgQgEDCRYxrtCxw4FFAg5
+CIRuli
BIHgrwgalAkciKmgn5rVCEVMxGgmyYY5X5qYRShLAgIDLMa8lcUBozwQTBbKJHVEw5GJFm
+C1eeCN
BEIF42l4MElLFgFlRRAURUrtWgGJIOzCgvCbAFSM9uJtsVfXyY4EsCqz26bwVK15N8yK6M
+ZPR48J
2FCm4I3FrJB5E/x5poXgN4IntS1j3PNEN9WiOuPuGpDjJ0FMKobk+pZgprSxNDlwzUTz2U
+RtvK1G
BDu26uawCFW2ONPqgmNWM784KUrLCLwNoSYqzmRycgqdRHAPR/gQcCOTRccnYfG1tkyA4K
+eNNxW9
IJxq5FCSIB4JDDCwl2GL3fBad+bcwEAEEVBViwClSVjYLPDdABRzInSTAxbi4PbWCxd+Q4
+KLErZG
wh8S3HdCgwyU0OFAtZWg4Q8BOLigXja+uNwPAkSQIw47TtVgDjhCueSNQE1phEIKCYBlRR
+cykOWX
G1yogZJAZCncmWimKVyDSlrZgplqximncEDMaWeazcl3p5o3hAAAIfkECQoAGwAsAwACAC
+wALQAA
Bf7gJo5kaZpBGpxs65aBoSjG+t74Fsy0nf+nHc0AABphvFnx+FIcLFAoIDVNMV+PQ2a7nT
+wKmkJh
43BsFteSQvPMWLoaiHgsoVAu5rSooWlMoF0KDxgYEA4QFwl2CS4LEIYtBw9sfxkTExsNjx
+B1iogO
jCMOFGUUhncQLAYNkwYTliIOEo+JigsJeSMJEKR2vqYsB6x+bhaHvAkJDwnDoSSypnYXvq
+knwg+v
XaYLZQ+s0M66nL4X07O4h6Ai15eXhNKsEALz4aKbdXUUjnem6joCByDgatCAn4MHEDQIQC
+ChXixZ
0x7humCoDKgBAxocEHBIwoVJsxywiqBBUaIS0P4egUqwoJ/KBBgFNOBYZ9rHOKOW4aLgsV
+4ZlqEc
ddwWc+O9iJM0QXhg6lHPF7g4RVxAgAA9TqcqTtLwQJChRwIclth5ZxrVATID8vr6M4GApC
+UPhYUK
cZq+qmg58uq3cuxVsWP5LRqAl9sjO4bQmNjFETCJlvwMJcPoaJYvf4sFQk2GiCdboGv35m
+KCbl80
aBap8Rp9ZBSFnYcP8SzjsZ8E1kZ4JXIkNerXOyE1p9l7S7Y8bmX28nWMY9Rq12bCstwrMZ
+keTx3x
jJAu66Xb66Sisp63CdQ8PRsSSFhAz+EuU8m4od+Fpj3KOysxM2HgKJR0ErC5hQtzLzAQgX
+4MhF+z
DyhCEdiCgSWFY6A44SVj3RUGRlCPABGIcpuDPzDAQBAiKKIfejgMiCIQIoKIXgDzwMiABh
+HAGOON
AsCYho3z9AghAz0GKaSOOfAopI8iHqlkjD8s6eSTaTwJpQshAAAh+QQJCgAbACwDAAEALA
+AuAAAF
/uAmjmRpmkEanGzrloGhKMb63vgWzLSd/6cdzQAAGmG8WfH4UhwsUCggNU0xX49DZrudPA
+qaQmHj
cGwW15JC88xYthYNRDx2QMppUkPTgE66Cg8YGHcQFAkSFwknZjkHDxoTkm4TGw0QmBKHFw
+sUDosj
Zpg5Bg2QB3+SZA6JFJsJF58kFBALEqM3B6YKf1B2hgkJDwumDaAjEBe1rne5Dw9/XbQLZQ
++mrIck
Dq7KFBe0EC+mE1ETg5mmEALrxyLb3t/ftGYJZXfHAQIHEAkNl60OHkDQIACBhHYJDHG7EI
+9asm+3
FgwY0OCAADsSID245cBUBA0JvCG0QyHRt1oK/ss4kDhAQIOLEFpB0vBg24Ng2xK125DQVc
+SQv+5N
1CcgJjxNMwU+ABdTkYh6rsAtsqcJ0wICBNjdMlTVzsxAhdQdW4CJHxoyTUvWGpC1oqE74D
+4lCABp
Tz2xJBIsOOvOEENaCbC2LMrMjtwSCdjxe0FSHgWJghNqUlZmwU6e6mS5SPjXFUusPZsePp
+HwsgnJ
fwvJxYhpmmkgUH3Cndealuc8oRTGfOcpbabXRlgnuyuBbFQJdoADIZvpggCHxv9+EoCbzE
+mFAvR+
Uug5Me4FJ1uF25DdodrEynG8q2eHuojyvxyUT/+Cs7p1fMlT05Q9Oe71DjEQAQMMoOWJXj
+3lh3dE
SIoEAwEDGgxIRiJn6RUTfS0YhwY1CRCo3TcdPtUJhi1sEw6CmN3yWAQDOrhYGiGNp9dTb3
+UYgXb3
pMFAQo0EM0I9oAQjJIknQLijCAIWWJ0LAkq4QZJLvkAgCUpG+UI+62SJ5ZbrbJkGllmGKe
+aYYfpw
A5hkpqlmlj+s6eaYabyZ5gshAAAh+QQJCgAbACwDAAIALAAtAAAF/uAmjmRplkEanGzroo
+aiGOtr
31sgzzXun7qZAfAronYy4mZhbCkOE4vUAkhVUxsHxOFgNkmPgyVDzkweBU2hkN1qt1+RQg
+OVkica
yLrgoFwSCQsUDglxDRoNURN3Cg8YGBAQFBAJFAkXhHEHD3QTixYTGw2RFJOAFAsJDnEbBg
+2cBoue
XJMLXA8Jrw2FrAe6i3eQtpEPrw4Slqwbvg+foBQYWhIXrxAC17y9rwpauQ1+FxIODxAaAg
+gS2SyS
qxuqC14iAQIH8H2cD8gOrxEalX/rMPgx9SaTiAYHBHCRdIGThgf3APWZlu0NhAultixgOI
+nLAAEN
BGyUEAmZBIfk/h5MKglQBIRpGDsKWtntY8KNFMRJijROg4ZGWyIJUCUJXE5MqiYh25KAwL
+UBG3cW
BCSA0yGiQ5e8QYYpFcuOCT4iTECqIyV17rBREqGKFlOyMEsRIvBxKMmiTE+QVZgNkCA4Gy
+6CIxmW
LtSO0yyhHUEWbaW8WYyCHUB5pha5i1uQ1ch4YE6egJKaHRTvRVt4JMiWyqiFy+Vwl7tk/n
+GZpARb
fkhhDEoIECuik1BJK3vBTehUqZoEerlz2BaYTJFb9P1jM8Oz9nZq9DsMWWkblYKbGhq64N
+vQ/2az
6LN6y7UN14ZyWZqc7dnql1ORTx3o8lp3kP0wDCZD1cfYctOkcMKFeqap5oBIBonAgH1IRa
+jcRgTa
wgsDEUxIVm/fXbiWfAlwqEEEHzJoRGhsJcdhisqYwOGEEkYgIYsxlsCABjRuwGGONjDQo4
+9AAhFf
fPMcmaQAScax5JFQRgnlPD48KeWVWDLpQ5ZcRhlHl1e+EAIAIfkECQoAGwAsAwADACwALA
+AABf7g
Jo5kaZpBGpxs65aBoSjG+t74Fsy0nf+nHc0AABphvBnAIVocWYrDxEK1AFLXFMWR2D5Nj0
+NmPJ48
CppC4QKBJCDbxFek0BwsGXxmooGoC3BdCRdccxsNGg1TE2UKDxgYgV0LCUyGBw92AYwWEw
+4NbQ4Q
DwsNDw1yhgamdlQTExIXlRASpw8OEhSpcwemDXp7kbEXphACx7u8pgqvrxQYFxQQDg8QGg
+IIEruW
R71h2hCI1dOOERpdsiJtTUbHB5WxmRq3FA8JlRSxcl0SDhQtlRY4ETGgwQEBovJJk1ftgb
+Q2+hbA
cYCLxAIuuDBQ0DVggIAGCGlBbLNAXjFRxv7uwdkiyoFEN7iikewo4CBKaS25CMhUZ5YAOR
+dj5aJw
gdCbh9MSDCBw7CJENhSTbUiAzM1UiRuJsrknTcI0lzQNivK6MamJNwhTqYRwIRcXibFwKq
+UpoM3D
stxIvFF7TyBRqwuyPlywlAABuPnatM3Lou9Kq1MFe+XScQDcaAm93HgTC8LAqbSK4nRzLz
+NOaVIB
3pNqehqcttOG9Uv6+clRov38Ed2yUaaDnwkofZmV1c3KLceNCcCqq3aO5aHZzmrDGScXqi
+Eh/wiA
T1pzihhD0cL502lqF03tUkAWvPTYaPl+l/YM5Gcu+huOIQsKf6Va7TgcAx9jIgQnympwfH
+R2YH3q
EThVJakkOMJe9VWim4Ml+LMLAxFE0M58mgGkHYce1lfeWBhuwMA9JXD4BDIJOUgiA4aUAO
+M0JzCg
AY01kqDfPQzw2GKPAQhQpH7HcLhjkUweM8eRSEYZZJBRIunDDVBWqeWWVf7A5ZdbzgEmly
++EAAA7'
) or die $!;
}
[download]

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

Comment on Gtk2 ....needs thread testing on a multi-threaded computer Download Code

Replies are listed 'Best First'.
Re: Gtk2 ....needs thread testing on a multi-threaded computer by zentara (Cardinal) on Dec 10, 2009 at 15:06 UTC
.... the only glitch i notice on my scrawny machine, is occaisionally 2(or more) winners will appear in a photo-style finish..... but the actual score reveals the true winner...... this had to be done, so i could move them in roughly 5 pixel steps....so the action would be good I'm not really a human, but I play one on earth. Old Perl Programmer Haiku	[reply]
Re: Gtk2 ....needs thread testing on a multi-threaded computer by kikuchiyo (Hermit) on Dec 15, 2009 at 23:31 UTC
I've got this on the first run: `panic: attempt to copy freed scalar 296b060 to 1511250 at gtkthreadtes +t.pl line 188. Segmentation fault` [download] I didn't see anything abnormal since that. By the way, is this what they call a race condition?	[reply] [d/l]
Re^2: Gtk2 ....needs thread testing on a multi-threaded computer by zentara (Cardinal) on Dec 16, 2009 at 14:34 UTC
*By the way, is this what they call a race condition* .....oooh i think i see the problem..... i thought $finish was the only var where locking was needed, but the main thread also resets $track{$tr}{'tot'} ...... each thread writes to it's own, but main resets them to zero ....on a single cpu machine it appears to work, probably because of its linear timing ....thanks for the report...i will have to think about how to handle locking $track{$tr}{'tot'} if you could give a quick try at line 188 `lock $track{$tr}{'tot'}; $track{$tr}{'tot'} += (rand 5) + $whip;` [download] I'm not really a human, but I play one on earth. Old Perl Programmer Haiku	[reply] [d/l]
Re^3: Gtk2 ....needs thread testing on a multi-threaded computer by kikuchiyo (Hermit) on Dec 16, 2009 at 19:12 UTC
I tried the fixed version - no segfaults this time, nor any other sign of incorrect behavior.	[reply]
Re^4: Gtk2 ....needs thread testing on a multi-threaded computer by zentara (Cardinal) on Dec 17, 2009 at 13:05 UTC
Re: Gtk2 ....needs thread testing on a multi-threaded computer by zentara (Cardinal) on Apr 03, 2012 at 18:22 UTC
Well, this is about as far as I'm taking this code. I fixed the locking problem, and some timing issues, but I still get an occaisional segfault. YMMV. I blame the libraries! :-) I had to throw in a goto, and put 2 buttons instead of sharing 1 ( it had something to do with timing). As far as that timing issue goes, I think its rooted in my use of select() delays in the threads, it probably should be done with timers in each thread. Using sleep( or select() delays ) in gui apps always ends up causing problems. This runs pretty well for me on a multi-core system, with an occaisional core dump or segfault, not many, but enough for me to give up on the code. Its no use kicking a dead horse. :-) Feel free to experiment. #!/usr/bin/perl use warnings; use strict; use MIME::Base64; use threads; use threads::shared; # apparently the &delete_event sub needs this to exit without GLib err +ors # it depends where you create the thread # ...i'm creating it well down in the Gtk2 code Glib::Object->set_threadsafe (1); use Gtk2 qw/-init -threads-init/; # usage: ./scriptname number_horses # the animated gif support in Gtk2 is a bit limited, and # it will only load from a disk file..... so i include # the base64 encoded image at the bottom, and write it to # disk, if not already done if( ! -e './horse.gif' ){ open (FH, '>', 'horse.gif') or die "$!\n"; print FH get_horsey(); close FH; } my $numworkers = shift \|\| 6; my %threads; share my $finish; $finish = 0; share my $go; $go = 0; share my $die; $die = 0; share my $restart; $restart = 0; my $window = Gtk2::Window->new; $window->signal_connect('destroy', \&delete_event); $window->set( border_width => 15 ); $window->set_size_request(800,600); my $vbox0 = Gtk2::VBox->new(0,0); $window->add($vbox0); my $hbox = Gtk2::HBox->new( 0, 6 ); $hbox->set_size_request(5,50); $vbox0->pack_start($hbox,0,0,0); my $sbutton = Gtk2::Button->new(' Start '); $sbutton->signal_connect( "clicked" => \&start ); $hbox->pack_start($sbutton,0,0,0); my $rbutton = Gtk2::Button->new(' Reset '); $rbutton->signal_connect( "clicked" => \&re_set ); $hbox->pack_start($rbutton,0,0,0); my $lab = Gtk2::Label->new(); $lab->set_markup("<span foreground=\"lightseagreen\" background +=\"black\" size=\"15000\">Race to 500</span>"); $hbox->pack_start($lab,0,0,0); my $ebutton = Gtk2::Button->new('Exit'); $ebutton->signal_connect( "clicked" => \&delete_event ); $hbox->pack_end($ebutton,0,0,0); my $winlab = Gtk2::Label->new(); $winlab->set_markup("<span foreground=\"lightseagreen\" backgro +und=\"black\" size=\"20000\">:Winner</span>"); $hbox->pack_end($winlab,0,0,0); my $wins = Gtk2::Label->new(); $wins->set_markup("<span foreground=\"lightseagreen\" backgroun +d=\"black\" size=\"20000\"> ? </span>"); $hbox->pack_end($wins,0,0,0); my $vbox = Gtk2::VBox->new(); my $sw = Gtk2::ScrolledWindow->new (undef, undef); $sw->set_shadow_type ('etched-out'); $sw->set_policy ('automatic', 'automatic'); $sw->set_size_request (500, 500); $sw->set_border_width(5); $vbox0->pack_start($sw,1,1,0); $sw->add_with_viewport($vbox); my $pba = Gtk2::Gdk::PixbufAnimation->new_from_file ('horse.gif'); foreach my $tr (1..$numworkers){ my $trackframe = Gtk2::Frame->new($tr); $vbox->pack_start( $trackframe, 0, 0, 0 ); $trackframe->set_border_width(3); my $trackhbox = Gtk2::HBox->new( 0, 6 ); $trackhbox->set_size_request(5,50); $trackframe->add( $trackhbox ); my $anim = Gtk2::Image->new_from_animation ($pba); $trackhbox->pack_start( $anim, 0, 0, 0 ); my $scorelab = Gtk2::Label->new(); $scorelab->set_markup("<span foreground=\"black\" size=\"20000\">0</span>"); $trackhbox->pack_end( $scorelab, 0, 0, 0 ); $threads{$tr} = threads->new( \&run, $tr, $winlab, $wins, $trackhbox +, $anim, $scorelab ); } $window->show_all(); $winlab->hide; $wins->hide; Gtk2->main; sub start{ $sbutton->set_sensitive(0); { lock $finish; $finish = 0; lock $restart; $restart = 0; lock $go; $go = 1; } } sub re_set{ $wins->hide; $winlab->hide; { lock $finish; $finish = 1; lock $restart; $restart = 1; lock $go; $go = 0; } $wins->hide; $winlab->hide; $sbutton->set_sensitive(1); } sub delete_event{ foreach my $tr (1..$numworkers){ $go = 0; $die = 1; $threads{$tr}->join; } Gtk2->main_quit; return 0; } sub run{ my ($tr,$winlab, $wins, $trackhbox, $anim, $scorelab ) = @_; $\|++; while(1){ if($die == 1){ return }; if ( $go == 1 ){ my $tot = 0; while(1) { my $whip = rand(5) - rand (1); $tot += 5 + (rand 10) + $whip; if ( $restart == 1){ Glib::Idle->add( sub{ $wins->hide; $winlab->hide; $trackhbox->set_child_packing ( $anim, 0, 0, 0 +, 'start'); $scorelab->set_markup("<span foreground=\"black +\" size=\"20000\">0</span>"); } ); goto RESET; } if ( $finish == 0){ if ($restart == 1){goto RESET} Glib::Idle->add( sub{ $tot \|\|= 0; my $total = sprintf('%.2f', $tot ); $total \|\|= 0.00; if ($restart == 0){ $trackhbox->set_child_packing ( $anim, 0, 0,$total , ' +start'); $scorelab->set_markup("<span foreground=\"black\" + size=\"20000\">$total</span>"); } #check for winner if($total > 500){ lock($finish); # prevent thread races :-) $finish = 1; $scorelab->set_markup("<span foreground=\"red\" size=\"20000\">$total</span>"); $wins->set_markup("<span foreground=\"red\" size=\"25000\">$tr</span>"); $wins->show; $winlab->show; } }); } RESET: if($die == 1){ return }; if ( $go == 0 ){last } select(undef,undef,undef,.1); } # end of go loop }else{ select (undef,undef,undef,.1) #sleep while loop } } #end of main while loop } sub get_horsey{ return decode_base64( 'R0lGODlhMgAwAMQbAAAAAAAIABgYGBhzGBitGDEAWjExSkpKa0qU/2NCIWtrhHtSKXtaW +oyMlKVr OcbGzs6EWs6cnN6EY+9zAO+ca/cA9/+tGP+te/+9c//nGP///wAAAAAAAAAAAAAAAAAAAC +H/C05F VFNDQVBFMi4wAwEAAAAh/jVCdWlsdCBieSBCbG9veiAtIGh0dHA6Ly9wZXJzby5jbHViLW +ludGVy bmV0LmZyL2xhYmdpYwAh+QQJCgAbACwEAAMALQAsAAAF/uAmjmRplkEanGzrmoGhKMb63r +gYzLSd /6wdzQAAGmG8WfF4UxwmlqgFkKKmRAuHg3l6HDJgsOVR0BQKIseF4mBzRwrNwSLOTDSQc6 +ENoVwS EA4JLA4QNw0aDVAWE3YKDxgYEJMUEAkUCxQUgySFfC8HDxoPE6V2Gw2UmgmsEAusJRBrbB +KGLQYN ogoCjRMbmhcSrAkPCbkNnCMLlBd9ky0HuQ+KGYx9rFoQ0w8OEn8lC8uafZVbJ9EPpGETkn +0SFLkQ AvPJyqqzlSwHjw1SExQY/ARz8ACCBgEIhJkoBMHbhVmCtNSbd6CVBEQP3gXKFUHDpW8lEh +TSxCZc w2YO/gaobHBAQCGHokaJpFBsprd6WMaFA+StnEoBDQQsU1UpZkFtlSbdHJFgqIOdC3pOSj +lAQEue zZIuMxqPoYB6UEWIxDfpp4ABmchNfbohQQBdHgt9dSHS4TgCVVlGVRXolYkE9CzRJfewFg +G88/io 8nsCkEucIfs81ET18IBu5ZwtaAEIMjhZfmoJUqmyTTnTm9+0lbwm0DBsUkemfpMFWCVAJA +NJnupK NbbQk7KQwzTcteccTbV4cyaSoaXiEgRx4ZmUnIOvw57iHhf9+Avc7tZcn4d958harWEBmV +komLx5 IugBFjnpZLNJ3hvLag6YBXlWwjU0jnQ3BDDTJv29gFBeOOetMRtnQqmRX2OvNScRXfN1xg +Q2nDDQ EQMsiARLU4IdkdwgHn5YAgMMDMNUiSZ2xuKMJHjYYj38TbfMcSyqR4KIbyTAYowRvMFiBC +ACIQAD GkQQwDxPPilAlFBOKUCNQ+YgZYrkdenll1MCISWYZJbZpZJmpumlamqSeUMIACH5BAkKAB +sALAQA AgAtAC0AAAX+4CaOZGmWQRqcbOuagaEoxvreuBjMtJ3/rB3NAAAaYbxZ8XhTHCxQKCA1TQ +EdEIhD tD09DplwePIoaAqFI0RCoWQpJoXmGbZkJhoIOr1xLCAbCydYWW8XFBJrJQ0aDRNQE3cKDx +gYWg4S F1oXXSUObZprF4dZJAcPcxOqdxsNpZgQbQmxCSexoG0UF4kkBg2oBgKREyNYmbIXCbIsxo +egvCMH vw0HAhkWEw7GEAsLCcretS5YuG4l0g/UYhNu3doPCdPiL8a5JugKqqqVWWzpD5iSvUigzZ +g3bfMC CDjwTVuDBpl2/YIgoOI8F98OInKTYMAAagK0raHw4EEbLQ/+IGgQgEDCRYxrtCxw4FFAg5 +CIRuli BIHgrwgalAkciKmgn5rVCEVMxGgmyYY5X5qYRShLAgIDLMa8lcUBozwQTBbKJHVEw5GJFm +C1eeCN BEIF42l4MElLFgFlRRAURUrtWgGJIOzCgvCbAFSM9uJtsVfXyY4EsCqz26bwVK15N8yK6M +ZPR48J 2FCm4I3FrJB5E/x5poXgN4IntS1j3PNEN9WiOuPuGpDjJ0FMKobk+pZgprSxNDlwzUTz2U +RtvK1G BDu26uawCFW2ONPqgmNWM784KUrLCLwNoSYqzmRycgqdRHAPR/gQcCOTRccnYfG1tkyA4K +eNNxW9 IJxq5FCSIB4JDDCwl2GL3fBad+bcwEAEEVBViwClSVjYLPDdABRzInSTAxbi4PbWCxd+Q4 +KLErZG wh8S3HdCgwyU0OFAtZWg4Q8BOLigXja+uNwPAkSQIw47TtVgDjhCueSNQE1phEIKCYBlRR +cykOWX G1yogZJAZCncmWimKVyDSlrZgplqximncEDMaWeazcl3p5o3hAAAIfkECQoAGwAsAwACAC +wALQAA Bf7gJo5kaZpBGpxs65aBoSjG+t74Fsy0nf+nHc0AABphvFnx+FIcLFAoIDVNMV+PQ2a7nT +wKmkJh 43BsFteSQvPMWLoaiHgsoVAu5rSooWlMoF0KDxgYEA4QFwl2CS4LEIYtBw9sfxkTExsNjx +B1iogO jCMOFGUUhncQLAYNkwYTliIOEo+JigsJeSMJEKR2vqYsB6x+bhaHvAkJDwnDoSSypnYXvq +knwg+v XaYLZQ+s0M66nL4X07O4h6Ai15eXhNKsEALz4aKbdXUUjnem6joCByDgatCAn4MHEDQIQC +ChXixZ 0x7humCoDKgBAxocEHBIwoVJsxywiqBBUaIS0P4egUqwoJ/KBBgFNOBYZ9rHOKOW4aLgsV +4ZlqEc ddwWc+O9iJM0QXhg6lHPF7g4RVxAgAA9TqcqTtLwQJChRwIclth5ZxrVATID8vr6M4GApC +UPhYUK cZq+qmg58uq3cuxVsWP5LRqAl9sjO4bQmNjFETCJlvwMJcPoaJYvf4sFQk2GiCdboGv35m +KCbl80 aBap8Rp9ZBSFnYcP8SzjsZ8E1kZ4JXIkNerXOyE1p9l7S7Y8bmX28nWMY9Rq12bCstwrMZ +keTx3x jJAu66Xb66Sisp63CdQ8PRsSSFhAz+EuU8m4od+Fpj3KOysxM2HgKJR0ErC5hQtzLzAQgX +4MhF+z DyhCEdiCgSWFY6A44SVj3RUGRlCPABGIcpuDPzDAQBAiKKIfejgMiCIQIoKIXgDzwMiABh +HAGOON AsCYho3z9AghAz0GKaSOOfAopI8iHqlkjD8s6eSTaTwJpQshAAAh+QQJCgAbACwDAAEALA +AuAAAF /uAmjmRpmkEanGzrloGhKMb63vgWzLSd/6cdzQAAGmG8WfH4UhwsUCggNU0xX49DZrudPA +qaQmHj cGwW15JC88xYthYNRDx2QMppUkPTgE66Cg8YGHcQFAkSFwknZjkHDxoTkm4TGw0QmBKHFw +sUDosj Zpg5Bg2QB3+SZA6JFJsJF58kFBALEqM3B6YKf1B2hgkJDwumDaAjEBe1rne5Dw9/XbQLZQ ++mrIck Dq7KFBe0EC+mE1ETg5mmEALrxyLb3t/ftGYJZXfHAQIHEAkNl60OHkDQIACBhHYJDHG7EI +9asm+3 FgwY0OCAADsSID245cBUBA0JvCG0QyHRt1oK/ss4kDhAQIOLEFpB0vBg24Ng2xK125DQVc +SQv+5N 1CcgJjxNMwU+ABdTkYh6rsAtsqcJ0wICBNjdMlTVzsxAhdQdW4CJHxoyTUvWGpC1oqE74D +4lCABp Tz2xJBIsOOvOEENaCbC2LMrMjtwSCdjxe0FSHgWJghNqUlZmwU6e6mS5SPjXFUusPZsePp +HwsgnJ fwvJxYhpmmkgUH3Cndealuc8oRTGfOcpbabXRlgnuyuBbFQJdoADIZvpggCHxv9+EoCbzE +mFAvR+ Uug5Me4FJ1uF25DdodrEynG8q2eHuojyvxyUT/+Cs7p1fMlT05Q9Oe71DjEQAQMMoOWJXj +3lh3dE SIoEAwEDGgxIRiJn6RUTfS0YhwY1CRCo3TcdPtUJhi1sEw6CmN3yWAQDOrhYGiGNp9dTb3 +UYgXb3 pMFAQo0EM0I9oAQjJIknQLijCAIWWJ0LAkq4QZJLvkAgCUpG+UI+62SJ5ZbrbJkGllmGKe +aYYfpw A5hkpqlmlj+s6eaYabyZ5gshAAAh+QQJCgAbACwDAAIALAAtAAAF/uAmjmRplkEanGzroo +aiGOtr 31sgzzXun7qZAfAronYy4mZhbCkOE4vUAkhVUxsHxOFgNkmPgyVDzkweBU2hkN1qt1+RQg +OVkica yLrgoFwSCQsUDglxDRoNURN3Cg8YGBAQFBAJFAkXhHEHD3QTixYTGw2RFJOAFAsJDnEbBg +2cBoue XJMLXA8Jrw2FrAe6i3eQtpEPrw4Slqwbvg+foBQYWhIXrxAC17y9rwpauQ1+FxIODxAaAg +gS2SyS qxuqC14iAQIH8H2cD8gOrxEalX/rMPgx9SaTiAYHBHCRdIGThgf3APWZlu0NhAultixgOI +nLAAEN BGyUEAmZBIfk/h5MKglQBIRpGDsKWtntY8KNFMRJijROg4ZGWyIJUCUJXE5MqiYh25KAwL +UBG3cW BCSA0yGiQ5e8QYYpFcuOCT4iTECqIyV17rBREqGKFlOyMEsRIvBxKMmiTE+QVZgNkCA4Gy +6CIxmW LtSO0yyhHUEWbaW8WYyCHUB5pha5i1uQ1ch4YE6egJKaHRTvRVt4JMiWyqiFy+Vwl7tk/n +GZpARb fkhhDEoIECuik1BJK3vBTehUqZoEerlz2BaYTJFb9P1jM8Oz9nZq9DsMWWkblYKbGhq64N +vQ/2az 6LN6y7UN14ZyWZqc7dnql1ORTx3o8lp3kP0wDCZD1cfYctOkcMKFeqap5oBIBonAgH1IRa +jcRgTa wgsDEUxIVm/fXbiWfAlwqEEEHzJoRGhsJcdhisqYwOGEEkYgIYsxlsCABjRuwGGONjDQo4 +9AAhFf fPMcmaQAScax5JFQRgnlPD48KeWVWDLpQ5ZcRhlHl1e+EAIAIfkECQoAGwAsAwADACwALA +AABf7g Jo5kaZpBGpxs65aBoSjG+t74Fsy0nf+nHc0AABphvBnAIVocWYrDxEK1AFLXFMWR2D5Nj0 +NmPJ48 CppC4QKBJCDbxFek0BwsGXxmooGoC3BdCRdccxsNGg1TE2UKDxgYgV0LCUyGBw92AYwWEw +4NbQ4Q DwsNDw1yhgamdlQTExIXlRASpw8OEhSpcwemDXp7kbEXphACx7u8pgqvrxQYFxQQDg8QGg +IIEruW R71h2hCI1dOOERpdsiJtTUbHB5WxmRq3FA8JlRSxcl0SDhQtlRY4ETGgwQEBovJJk1ftgb +Q2+hbA cYCLxAIuuDBQ0DVggIAGCGlBbLNAXjFRxv7uwdkiyoFEN7iikewo4CBKaS25CMhUZ5YAOR +dj5aJw gdCbh9MSDCBw7CJENhSTbUiAzM1UiRuJsrknTcI0lzQNivK6MamJNwhTqYRwIRcXibFwKq +UpoM3D stxIvFF7TyBRqwuyPlywlAABuPnatM3Lou9Kq1MFe+XScQDcaAm93HgTC8LAqbSK4nRzLz +NOaVIB 3pNqehqcttOG9Uv6+clRov38Ed2yUaaDnwkofZmV1c3KLceNCcCqq3aO5aHZzmrDGScXqi +Eh/wiA T1pzihhD0cL502lqF03tUkAWvPTYaPl+l/YM5Gcu+huOIQsKf6Va7TgcAx9jIgQnympwfH +R2YH3q EThVJakkOMJe9VWim4Ml+LMLAxFE0M58mgGkHYce1lfeWBhuwMA9JXD4BDIJOUgiA4aUAO +M0JzCg AY01kqDfPQzw2GKPAQhQpH7HcLhjkUweM8eRSEYZZJBRIunDDVBWqeWWVf7A5ZdbzgEmly ++EAAA7' ) or die $!; } [download] I'm not really a human, but I play one on earth. Old Perl Programmer Haiku ................... flash japh	[reply] [d/l]