Hi, I ran your program and can see what the problem is. You are creating too many canvas items, and not deleting them when they leave the visual part of the canvas. After you hit about 6000 items, the canvas bogs down because it can't update that many items in the time span you give it. Any Tk widget can be overloaded to the point where it bogs down.

So what you need to do is watch for when an item leaves the visible canvas, then delete it. Even that may not be good enough. What you should do is create a set of display objects, as many as you want to handle in view at any one time, and reuse them, and reconfigure them. The script below demonstrates this. I used Zinc, instead of Tk, because I wanted rotations, and some other cool Zinc stuff, but the same principle would work in the plain Tk canvas. I create 100 bubble objects, and when they leave the viewable screen, I don't delete them, but reconfigure them to be reused. This script can run all day, without bogging down. 

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

my $mw = MainWindow->new;
$mw->geometry("700x600");
$mw->resizable(0,0);

my $launcher;
my $zinc = $mw->Zinc(-width => 700, -height => 565,
                    -backcolor => 'black',
            -borderwidth => 3, -relief => 'sunken')->pack();

# Then we create a filled rectangle, in which we will display explain 
+text.
$zinc->add('rectangle', 1 , [200, 400, 490, 490],
       -linewidth => 2,
       -filled => 1,
       -fillcolor => 'SkyBlue',
       -priority => 1,
       );

my $text = $zinc->add('text', 1,
              -position => [350, 445],
              -anchor => 'center',
              -priority => 3,
              -width => 200,
              );

#####setup 100 bubble objects for reuse#############################
my %bubs;       #reusable object space
our @bubjects = (1..100);   #shared array for object reuse 
my @x = (1,-2,3,-4,5, -1,2,-3,4,-5 ); #give random diagonal motion
our $count = 0;

foreach my $bub (@bubjects){
     $count++;
     my $tag = $count;
     push (@x,shift(@x));  
     my $afterdelay = 1 + int(rand(99));
    
# Create the 100 ztkbubble object (see Package ztkbubble below)
 $bubs{$bub} = ZtkBubble->new(
                 -widget => $zinc, 
                 -name => $count,
                 -bub => $bub,
         -tags => $tag,
                 -x => rand 700,
                 -y => 700,
         -radius => 10 + rand(30),
         -color => 'white',
         -dx => $x[0],
         -dy => -20,
         -afterdelay => $afterdelay,  
                );
}
###########################################################

# Display comment
&comment("Strike any key to begin");

# Create Tk binding
$mw->Tk::bind('<Key>', \&openmode);

my $closebutton = $mw->Button(-text => 'Exit', 
    -command => sub{ 
                 if(defined $launcher){$launcher->cancel};
        exit(0); 
        })->pack; 

MainLoop;
#####################################################
sub openmode {
    $mw->Tk::bind('<Key>', \&closemode);
     &comment("Bubbling!!");


# 50 is about my max on a 800 Mhz K6, adjust accordingly
$launcher = $mw->repeat(500,sub{
         my $bub = shift @bubjects;
    $bubs{$bub}->bubble_move();
#        print "bubjects->@bubjects\n";
   });
}


sub closemode {
    # and then inform user
    &comment("We are bubbling baby !!");
}

# Just display comment 
sub comment {
    my $string = shift;
    $zinc->itemconfigure($text, -text => $string);
}


#=====================================================================
+========
#                ZtkBubble  Class
#=====================================================================
+========
package ZtkBubble;
use strict 'vars';
use Carp;

#====================
# Object constructor
#====================
sub new {
    my ($class, %arg) = @_;

    # object attributes
    my $self = {
    'widget' => $arg{-widget},      # widget reference into which it g
+oes
    'name'  => $arg{-name},         #identifying name 
        'bub'  => $arg{-bub},           #which reusable bubble space i
+t's using
    'tags' => $arg{-tags},            # tag object of self
    'x' => $arg{-x},
    'y' => $arg{-y},               # origin coordinates
    'radius' => $arg{-radius},      # radius
    'color' => $arg{-color},        # top Group item
    'dx' => $arg{-dx},              # initial x direction 
    'dy' => $arg{-dy},              # initial y direction 
    'afterdelay' => $arg{-afterdelay},       # repeater time delay
    };
    bless $self;    

#   print "just blessed $self\n";
    $self->{self} = $self;     

    $self->{topgroup} = $self->{widget}->add('group', 1, 
                                       -priority => 2,
                                       -visible => 1);
    
    $self->{widget}->coords($self->{topgroup}, [$self->{x},$self->{y}]
+);
    $self->{timer} = ''; #declare variable to store internal timer 
    $self->{'init'} = $self->{widget}->tget( $self->{topgroup}  );    
    # print join ' ',@{ $self->{init}  },"\n";  #initial position

   my $color1 = '#';
   for (0 .. 2){
     my $rgb = unpack('H*', pack('n', (int(rand(192)+64))));
     $rgb =~ s/.+(\w\w)$/$1/;
     $color1 .= $rgb;
}

#add items to self group
    
    $self->{arc1} =
    $self->{widget}->add('arc',  $self->{topgroup},
             [-$self->{radius}, -$self->{radius}, $self->{radius}, $se
+lf->{radius}],
#             -visible => 1,
             -filled => 1,
#             -closed => 1,
#             -extent => 360,
#             -pieslice => 1,
             -fillcolor => $color1,
#             -linewidth => 1,
#             -startangle => 0 ,
             -tags => [$self->{tags},'bubble'],
             );
  $self->{arc2} =
  $self->{widget}->add('arc',  $self->{topgroup},
             [-$self->{radius}/2, -$self->{radius}/2, $self->{radius}/
+2, $self->{radius}/2],
#             -visible => 1,
             -filled => 1,
#             -closed => 1,
#             -extent => 360,
#             -pieslice => 1,
             -fillcolor => $self->{color},
#             -linewidth => 1,
#             -startangle => 0 ,
             -tags => [$self,'bubble'],
             );

    # Create the Text item representing the jackpot.
    $self->{txt} =
    $self->{widget}->add('text', $self->{topgroup},
         -position => [0, 0],
         -anchor => 'center',
         -text => $self->{'name'},
         
         );
    
    $self->{line} =
    $self->{widget}->add('curve',  $self->{topgroup},
             [-$self->{radius}, -$self->{radius},$self->{radius}, $sel
+f->{radius}],
             -visible => 1,
             -linecolor => 'white',
             -linewidth => 3,
             -tags => [$self,'bubble'],
             );
    return $self;
}
#############################################
sub DESTROY{
  my ($self) = @_;
    print "destroying->",$self,' ', $self->{bub}. "\n";
}
###########################################
#================
# Public methods
#================

# Start motion of $self 
sub bubble_move {
    my $self = shift;
$self->_move();
}

#=================
# Private methods
#=================

sub _close {
    my ($self) = @_;
    my $widget = $self->{widget};
    my $group = $self->{topgroup};
    my $name = $self->{name};
    my $bub = $self->{bub};
    my $tag = $self->{tags};
    
    &main::comment("Poof!!   name->$name    bub#->$bub");
    $widget->dtag($tag);
    $self->{timer}->cancel;
    push @main::bubjects, $self->{bub};  #return to pool

#$self->DESTROY;    #don't use this, since we are reusing them
}

# Generate motion and  rotation animation.
sub _move {
    my ($self) = @_;
    my $widget = $self->{widget};
    my $group = $self->{topgroup};
    $widget->translate($group, $self->{'dx'} ,$self->{'dy'});
 
   $self->{x} += $self->{'dx'}; 
   $self->{y} += $self->{'dy'}; 
 
 #check for side collisions
   if( ( $self->{x} < 0) or ($self->{x} > $self->{widget}->reqwidth ) 
+)
       { $self->{'dx'} *= -2 }


 #reset bubbles for next run with new name
 if($self->{y} < -$self->{radius}){ 
             $self->_close(); 
                
         $self->{widget}->tset( $self->{topgroup} , @{ $self->{init} }
+ );
             # print join ' ',@{ $self->{init}  },"\n";
         $self->{x} = ${ $self->{init} }[4];
         $self->{y} = ${ $self->{init} }[5];
         # $self->{widget}->coords($self->{topgroup}, [$self->{x},$sel
+f->{y}]);
         $self->{name} = $main::count++;
         $self->{widget}->itemconfigure($self->{txt}, -text => $self->
+{'name'} );
         return }  

 $widget->rotate($group,.9,$self->{x},$self->{y} );

#use $self->timer instead of anonymous timer, in order to cancel on cl
+ose 
$self->{timer} = $widget->after($self->{afterdelay}, sub { $self->_mov
+e() });
}

1;

[download]
I'm not really a human, but I play one on earth. Cogito ergo sum a bum

In reply to Re: Problems with Tk freezing by zentara
in thread Problems with Tk freezing by wulvrine

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.