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; }
In reply to Problems with Tk freezing by wulvrine
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |