in reply to Perl/Tk without events

First, if you really want to do it without events, you should consider writing your data to a single image, then occaisionally display the image with a run-once-and-discard Tk program. But the best way, is as follows:

Since you are new to Tk and event loop systems, you probably are unaware that you cannot use "sleep" in an eventloop system, without causing problems similar to yours. Sleep interferes with the event loop.

What you want to do is use a timer, and probably a canvas, that repeatedly calls your update. Something like: 

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $top=MainWindow->new();
my $canvas=$top->Canvas(width=>300, height=>245)->pack();

$top->bind('<Control-c>' => \&exit); 
$top->bind('<Control-q>' => \&exit);  

my $origin_x=110;
my $origin_y=70;
my $PI=3.141592635;
my $circle_radius=5;
my $path_radius=0;
my $angle = 0;

&animate();

$top->Button(-text=> 'Again', -command=>\&animate)->pack;
            
MainLoop();

sub animate{

  $canvas->delete('circles');

  $origin_x=110;
  $origin_y=70;
  $circle_radius=5;
  $path_radius=0;
  $angle = 0;

  my $repeater;

  $repeater = $top->repeat(500,  sub{  #500 milliseconds
        $path_radius+=7; 
        $circle_radius+=3; 
        $angle+=10;
    
        my $path_x=$origin_x+$path_radius*cos($angle*$PI/90);
        my $path_y=$origin_y-$path_radius*sin($angle*$PI/90);
    
        $canvas->create('oval', $path_x-$circle_radius,
                    $path_y-$circle_radius,
                    $path_x+$circle_radius,
                    $path_y+$circle_radius,
                    -fill=>'yellow',
                -tags => ['circles'],
                );
                    
       $canvas->create('line', $origin_x, $origin_y,
                    $path_x, $path_y,
                    -fill=>'slategray',
                -tags => ['circles'],
                );
    
    if( $angle > 180 ){ $repeater->cancel } 
    }
  );
}

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

Replies are listed 'Best First'.
Re^2: Perl/Tk without events
by alexxxm (Acolyte) on Aug 06, 2010 at 07:34 UTC
    thanks to all of you for your help - yes indeed I kept code at a minimum ...

    I was able to let it work with the following: my confusion was due (I guess it's usual) to my bad understanding of MainLoop: I believed it was <always> necessary, and I didnt know where to put it.

    Instead with DoOneEvent in the right place everything seems ok now...

    
init();

$mw->bind("KeyPress>",sub {exit});

while(1)
{
    life();
    DoOneEvent();
}

sub life
{
  updatecells();
  showcells();
}

    [download]

    thanks again!

    alessandro

[reply]
[d/l]
      if putting too much code isnt a problem - just as a "thank you" here is the whole prog.

      Remarkably simple, I really like perl/Tk!

      Play with it if you want, copyright is "do whatever you want with it"

      alessandro 

      #!/usr/bin/perl -w
# ------------------------ @alexxx2010
# ------------- Life 2D

=begin
 

=end
=cut


use Tk;
use Time::SoFar  qw( runtime runinterval figuretimes );

my ($mw,$canvas,$info,$lifeid);
my ($w,$h);
my $lc=5;


my $gen=0;
my $d;
my $syn;
my ($i,$j,$k,$l,$n,$a,$b);
my ($c,$cc);


open(F,">ca.log");
$d=`date`;
print(F "program running: $0\n");
print(F "$d starting...");


$mw = new MainWindow( -background => "black" );
($w, $h) = ($mw->screenwidth, $mw->screenheight);



#$mw->bind("<Motion>",sub {      # stop if mouse moved
$mw->bind("<KeyPress>",               # stop if keyboard press
      sub {
          $d=`date`;
          print(F " $d exiting\n"); close(F);
          exit
      });


# UNCOMMENT
#  ONCE EVERYTHING RUNS OK - DO NOT DEBUG WITH THESE LINES ON!
#$mw->FullScreen(1);
#$mw->grabGlobal;    # these last two to force FullScreen()
#$mw->focusForce;    # to correctly behave (from perlmonks)


$w+=2;$h+=2;
$mw->geometry ($w . 'x' . $h . '+-1+-1');  # to fullscreen

$w-=100;$h-=100;
print(F "\nw=$w\th=$h\ncell width $lc\n");
$canvas = $mw->Canvas(-width => $w, -height => $h, -background => "bla
+ck") -> pack(-pady=>10);
$info = $mw->Canvas(-width => $w, -height => 20, -background => "black
+") -> pack;

my ($x,$y);
my %cells;


# Init cells
my $p=0.3;

for $i(1..$w/$lc)
{
    for $j(1..$h/$lc)
    {
    if (rand()<$p)
    { $cells[0][$i][$j]=1; $cells[1][$i][$j]=1 }
    else { $cells[0][$i][$j]=0; $cells[1][$i][$j]=0 }
    }
}

runtime();

while(1)
{
    life();
    DoOneEvent();
}


exit;         # should never reach here anyway...

# ====================================================================
+=========================
#                                       SUBS
# ====================================================================
+=========================


sub life
{
    $gen++;

    $info->createRectangle(0,0,$w,20,-fill=>"black");
    $info->createText(10,10,-text=>"GEN $gen",-anchor=>"w", -fill=>"wh
+ite");
    $info->update;

    updatecells();

    showcells();

    $sin = runinterval(1);
    print(F "\tTime since then $sin\n-----\n");   # extract it with  p
+erl -wne 'if(/:(\d*)\n/){print "$1\n"}' ca.log >a.dat
}


sub updatecells
{
    if(($gen % 2)==1){ $c=0; $cc=1} else {$c=1;$cc=0}

    for $i(1..$w/$lc)
    {
    for $j(1..$h/$lc)
    {
        $n=0;
        for $k($i-1..$i+1) { 
        for $l($j-1..$j+1) {
            if (($i!=$k) or ($j!=$l))
            {
            if($k<1){$k=$w/$lc}; if($l<1){$l=$h/$lc}
            if($k>$w/$lc){$k=1}; if($l>$h/$lc){$l=1}
            $n += $cells[$c][$k][$l];
            }
        }}
        
        if($cells[$c][$i][$j]==1)
        { if(($n==2) or ($n==3)) { $cells[$cc][$i][$j]=1 } else { $cel
+ls[$cc][$i][$j]=0 } }
        else
        { if($n==3)    { $cells[$cc][$i][$j]=1 } else { $cells[$cc][$i
+][$j]=0 } }
    }
    }

    print(F "GEN $gen\n\tcells updated\t");

}


sub showcells
{
    my($u,$v);

    if(($gen % 2)==1){$c=0} else {$c=1}

    $canvas->delete('all');

    $u=$w/$lc; $v=$h/$lc;

    for $i(1..$u)
    {
    $a=($i-1)*$lc+1; 
    for $j(1..$v)
    {
        $b=($j-1)*$lc+1;
        if ($cells[$c][$i][$j]==1)
        {$canvas->createRectangle($a,$b,$a+$lc,$b+$lc,-fill=>"white")}
#        else
#        {$canvas->createRectangle($a,$b,$a+$lc,$b+$lc,-fill=>"black")
+}
    }
    }
    print(F "\tcells drawn\n");
}

      [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom