| zentara 2004-09-21, 3:58 pm |
| On Tue, 21 Sep 2004 11:11:13 +0200, Ruud Grosmann <r.grosmann@sdu.nl>
wrote:
>for some time ago, I wrote a routine that scales a TK::Photo object using
>a fraction as scale factor (Thumbnail only accepts integer scale
>factors). It seemed to work well, but when using the routine I got
>serious performance problems.
>
>I have made a small script that shows the problem, it is attached. It
>shows a window containing a picture, together with two buttons to zoom in
>or zoom out. The more times those buttons are pressed, the slower the
>Can anybody explain what is wrong? Is there a way to zoom a picture with
>a non-integer factor and not encountering this kind of problems?
Well your memory increases dramatically with each button press, which
indicates you are not reusing your objects properly.
Your script is kind of complex, for me too see where the fault lies,
but a regular here, Martin Hermann, has done a nice zoom script
at
http://herrmanns-stern.de/software/etc/tkjpegZoom
Maybe you should look how he has done it.
As far as debugging your script, I use the following when tracking down
memory problems. At the top of your script, put
use lib '.';
use MeM;
and put the following 2 files in the directory where you are testing.
It will open a little window in the upper left corner, and display your
current memory. As you click buttons, watch what happens.
From first glance, I'm guessing you are creating multiple canvases.
MeM.pm
########################################
#################
package MeM;
use warnings;
use strict;
use vars qw(@ISA @EXPORT_OK);
@ISA = qw(Exporter);
# inherit the import() from Exporter.pm
@EXPORT_OK = qw(init);
# list of things to export if asked to
my $pid = $$;
if(fork() == 0){exec './memmonitor.pl', $pid }
1;
########################################
################
memmonitor.pl
########################################
################
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $pid = shift || $$;
open(CHILD, "< /proc/$pid/status") or die "Can't open: $!";
my $mw = new MainWindow;
$mw->overrideredirect(1);
my $t = $mw->Label(-text=>'', -bg=>'black', -fg=>'yellow')->pack;
my $id = Tk::After->new($mw,1000,'repeat',\&refresh);
MainLoop;
sub refresh{
my @size = <CHILD>;
(my $vmsize) = grep {/VmSize/} @size;
my (undef,$size) = split "\t",$vmsize;
$size =~ s/^\s+//g;
chomp $size;
$t->configure(-text=>"PID: $pid -> $size");
s CHILD, 0, 0 or die "Cannot rewind $!";
if($size eq ''){close CHILD; Tk::exit}
}
########################################
#################
--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html
|