Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Problems with Tk freezing

by wulvrine (Friar)
on Feb 06, 2007 at 14:57 UTC ( [id://598553]=perlquestion: print w/replies, xml ) Need Help??

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

A question for my fellow monks,
I am having difficulty with a small TK program I am writing that moves little 'bots' around on a canvas. After a short period, TK canvas will stop any display updates. The program continues to run underneath, but the updates no longer happen.

I have shrunk the original program down to this example that brings up a 150x150 pixel canvas with 6 'bots' only travelling up, covering the screen one pixel at a time with a color. After a few minutes of running the updates will just 'stop'.

I am keeping track of the canvas ids for 'deletion' when a bot walks over a pixel already drawn in an attempt to limit the number of ids. However, even at 100x100, thats 10k canvas ids. I do, however, want to 'walk' one pixel at a time. Could this be just hitting a wall with too many id's or some other memory requirement?

Any help is appreciated.

#! /usr/bin/perl ############## # freeze.pl # ############## use strict; use warnings; use Tk; my $mw; #main window my $maxX = 150; my $maxY = 150; my $canvasMaxX; my $canvasMaxY; my $canvas; #canvas object my %bots; #Hash containing bot ID's, position, color my $debug = 1; # Pack parameter abbreviations my $psides = { 't' => 'top', 'l' => 'left', 'r' => 'right', 'b' => 'bo +ttom' }; my $pfills = { 'b' => 'both', 'n' => 'none' }; #main display grid my @dispGrid; #set entire grid to some neutral color map { my $row = $_; map {$dispGrid[$row][$_]{"colored"} = 0; } (0..$maxY); } (0..$maxX); #create the main gui etc create_gui(); #place bots at random positions with #random colors and directions for my $b (0 .. 6) { $bots{$b}->{"x"} = 0 + $b*(($maxX/6)); $bots{$b}->{"y"} = $maxY/2; } #Move the bots and update the display, repeatedly $mw->repeat(100,\&updateBots); MainLoop(); ############################### ### Convenience Tk routines ### ############################### sub packit { my ($w, $side_exp_fill) = @_; my ($side, $exp, $fill) = ($side_exp_fill =~ /(.)(.)(.)/); defined($psides->{$side}) and $side = $psides->{$side}; defined($pfills->{$fill}) and $fill = $pfills->{$fill}; $w->pack(-side => $side, -expand => $exp, -fill => $fill); return $w; } sub frame { my ($w, $bg, $side_exp_fill) = @_; my $fr = $w->Frame(-bg => $bg); return packit($fr, $side_exp_fill); } #state normal, disabled, hidden sub canvas { my ($w, $width, $h, $state, $psub, $side_exp_fill) = @_; my $bg = $w->cget(-bg); my $c = $w->Canvas(-bg=>$bg, -state=>$state); $psub and $c->configure(-command => $psub); $h and $c->configure(-height => $h); $width and $c->configure(-width => $width); return(packit($c,$side_exp_fill)); } #Create the main gui interface sub create_gui { # Main applcation window. $mw = MainWindow->new("title", "tk-freeze"); #Create a group of frames to help in aligning items my $mainFrame = frame($mw, 'cyan', "t1b"); my $canvasFrame = frame($mainFrame, 'white', "t1b"); my $canWidth = $maxX; my $canHeight = $maxY; $canvas = canvas($canvasFrame, ,$canWidth, $canHeight, "normal", 0, +"t1b"); } #delete a previously drawn bot #use the group id to delete group members sub deleteBot { my ($bid)= @_; my $bcid = $bots{$bid}{"canvasID"}; #delete the old drawing of this bot if (defined $bcid) { $canvas->delete($bcid); } $bots{$bid}{"canvasID"} = undef; } #draw a bot, be wary of edje cases. Also change #bot facing and its color sub drawBot { my ($bid) = @_; #clear out old version of drawn bot deleteBot($bid); my $bx = $bots{$bid}{"x"}; my $by = $bots{$bid}{"y"}; my $bnx = $bots{$bid}{"newX"}; my $bny = $bots{$bid}{"newY"}; #need color name to use in 'draw line' function my $bc = "magenta"; #draw new bot #while going through directions see if we hit boundary conditions my $boundHit = boundcheck($bid); my $body = $canvas->createRectangle($bnx-1,$bny-1,$bnx+1,$bny+1); #save canvasID for later use $bots{$bid}{"canvasID"} = $body; #draw line if ($boundHit == 0) { #delete any line id that might already exist at the point in que +stion my $line = $dispGrid[$by][$bx]{"lineID"}; $canvas->delete($line) if ($line); #draw new line, remember the id my $id = $canvas->createLine($bx,$by,$bnx,$bny,-fill=>$bc,-tag=> +"line"); #save id of new line for later deletion $dispGrid[$by][$bx]{"lineID"} = $id; } #update the display grid showing spot has been colored $dispGrid[$by][$bx]{"colored"}= 1; $bots{$bid}{"x"} = $bots{$bid}{"newX"}; $bots{$bid}{"y"} = $bots{$bid}{"newY"}; #debugging stuff, how many canvas items do we have. my @tags = $canvas->find("all"); my $total = $#tags +1; print " There are " . @tags . " canvas items \n" if ($debug); } #move a bot to its new position, sub moveBot { my ($bid) = @_; my $bx = $bots{$bid}{"x"}; my $by = $bots{$bid}{"y"}; $bots{$bid}{"newX"} = $bx; $bots{$bid}{"newY"} = $by-1; #have we hit something already drawn upon, move over a pixel if ($dispGrid[$by][$bx]{"colored"} == 1) { $bots{$bid}{"newX"} = $bx+1; } } sub updateBots() { #cycle through all 'bots', update all the bots position and directio +n foreach my $bot (keys %bots) { moveBot($bot); drawBot($bot); } } #did we hit a side? sub boundcheck { my ($bid) = @_; my $hit = 1; my $nx = $bots{$bid}{"newX"}; my $ny = $bots{$bid}{"newY"}; if ($nx>$maxX) { $bots{$bid}{"newX"}= 0; } elsif ($ny<0) { $bots{$bid}{"newY"}= $maxY; } else { $hit = 0; } return $hit; }
s&&VALKYRIE &&& print $_^q|!4 =+;' *|

Replies are listed 'Best First'.
Re: Problems with Tk freezing
by zentara (Archbishop) on Feb 06, 2007 at 17:43 UTC
    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;

    I'm not really a human, but I play one on earth. Cogito ergo sum a bum
Re: Problems with Tk freezing
by rinceWind (Monsignor) on Feb 06, 2007 at 15:36 UTC

    You might want to pepper some of your callbacks with calls to $mw->update, especially where it's compute bound.

    --

    Oh Lord, won’t you burn me a Knoppix CD ?
    My friends all rate Windows, I must disagree.
    Your powers of persuasion will set them all free,
    So oh Lord, won’t you burn me a Knoppix CD ?
    (Missquoting Janis Joplin)

      rinceWind,
      Thanks for the quick response. I have tried this already, and it still freezes but when it exits displays a 'deep recursion' error. So I had to remove it. :(

      s&&VALKYRIE &&& print $_^q|!4 =+;' *|

        Having a second look at the code, your app looks very busy. When does it ever hand control back to the event loop to process events?

        My suggestion is to defer some of the movement events by using timers with after or repeat. This will relinquish some control back to the controlling event loop, and it might get a chance to service some events that have been queued up.

        --

        Oh Lord, won’t you burn me a Knoppix CD ?
        My friends all rate Windows, I must disagree.
        Your powers of persuasion will set them all free,
        So oh Lord, won’t you burn me a Knoppix CD ?
        (Missquoting Janis Joplin)

Re: Problems with Tk freezing
by eric256 (Parson) on Feb 06, 2007 at 16:21 UTC

    If you use a pattern like Language::Logo where the graphic portion is a separate thread, then you could handle the bots in one thread and the display in a separate thread. Then your bots could update at a rate that is not linked to your display refresh. I don't know how to do this ;) but it would be cool if someone built a module that would allow this kind of disassociation between a Tk window and long running processes


    ___________
    Eric Hodges

      Fork a process with a piped open, open2 or open3 (to do the bot stuff), then use Tk::fileevent.

      --

      Oh Lord, won’t you burn me a Knoppix CD ?
      My friends all rate Windows, I must disagree.
      Your powers of persuasion will set them all free,
      So oh Lord, won’t you burn me a Knoppix CD ?
      (Missquoting Janis Joplin)

Re: Problems with Tk freezing
by wulvrine (Friar) on Feb 06, 2007 at 18:39 UTC
    Thanks for the help all!
    rinceWind
    I am unsure where to try those update commands, every place I have tried has left me with a 'deep recursion' error

    eric256<bbr> Good Idea though I think I will have the same problem doing the client server technique I suggested to liverpole for that project.

    Zentara
    Besides a great example zinc code (cool! thanks!) I think you have hit the problem on the head. The unfortunate problem is, I 'am' doing just that. At least as far as the original concept is concerned. @dispGrid is actually recording the id of the line going over that pixel. Later, if another line (not in this smaller example) walks over a path, it uses @dispGrid to erase the pixel and re-draw the new one, re-recording the ID. Remove the following section from the above code

    if ($dispGrid[$by][$bx]{"colored"} == 1) { $bots{$bid}{"newX"} = $bx+1; }
    which will move the bot over one position if it hits something already walked upon. Re-run and after they make one full screenwidth the ids stop accumulating.
    I really wanted to walk a line one pixel at a time, so every pixel is, unfortunately, a seperate, persistant line segment. The items never 'go off the canvas' they wrap around and continue (or potentially bounce). So this little project may be just too 'big' for Tk's abilities to handle??

    Thanks for the help!!

    s&&VALKYRIE &&& print $_^q|!4 =+;' *|
      Yeah, I see you try to handle deleting objects in your code, but the sad fact is, you are overlooking something. In my experience, it is a hash key that is not getting completely removed, or you get auto-vivication in some hashes. But without actually trying to trouble shoot your code, and just from your comment " so every pixel is, unfortunately, a seperate, persistant line segment" , you need to rethink how you draw your lines, so that every pixel IS NOT a new segment.

      My first thought would be to create 1 segment for each moving object. Then as it moves and consumes another pixel, reconfigure the original segment to the end points of the collective pixels. If you think about it a bit, you should be able to do this easily, especially if they move vertically.

      I encountered a similar problem in Tk Realtime data aquisition, where I was adding many segments to a continuing graph, and the cpu would bog down after awhile. My solution was to use segments up to a point, then write them out as a solid non-updating curve, then start another temporary segment.

      So this little project may be just too 'big' for Tk's abilities to handle??

      No you are reaching a point where your desire to use straight forward programming techniques is hitting the limit, where you need to start creatively juggling. Just about any language you use, that has a canvas (and canvas items) will be the same. You cannot expect a widget to handle a gazzillion items, as effectively as a few hundred. BUT if you really insist on following your way of thinking, you might want to switch to SDL. SDL dosn't have the notion of line segments to keep track of, In SDL you write something to the screen and forget it and move on. This has advantages in situations like yours, but disadvantages in that there is no way to easily identify and manipulate an existing segment, and if it gets erased from the screen, it's gone.

      Just think about an algorithm that you can feed a set of points (pixels) and it will return 2 pixels which are the extreme end points. Then use those 2 points to reconfigure the bot on the update. That way your canvas will only be handling a fixed number of lines at any one time, just making them longer thru a reconfigure. Or if you eventually want to move along curves, use the technique I showed in Tk Realtime data aquisition, and have each bot, after say 100 updates, leave the last 100 points as a solid non-updatable curve, then start another 100 pixel set which is continually updated.


      I'm not really a human, but I play one on earth. Cogito ergo sum a bum
        Again thanks for your time and assistance.
        In the final program the lines would be walking across each other, in the end most probably changing every pixel. I thought about adding pixels together to form a line, then break it later when it is crossed. But in the end, it will probably be every pixel for himself, sitting there until it is 'walked over' and changed in color.
        Is there a way in the canvas item that would allow me to color a pixel, but immediately throw away the id string. I am only keeping them around so that I can delete them later. I just want to color the pixel, leave it that way, and move on. If a 'bot' crosses over another line, it should change the pixel to its color, and move on. I don't know of any way to do that that is 'id'less.
        Thanks for any help!!

        s&&VALKYRIE &&& print $_^q|!4 =+;' *|

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://598553]
Approved by liverpole
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others goofing around in the Monastery: (1)
As of 2024-04-25 19:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found