[SPAM:###] Re: [SPAM:###] memory problem while displaying images

Ruud Grosmann <r.grosmann@sdu.nl> writes:
>[I sent this message earlier, but I'm not sure it did arrive in the list;
>couldn't find it in the archive. ]
>
>hi,
>
>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
>script gets; at my computer clicking 5 times is sufficient to make X very
>slow( when the gif image is only 150 K in size). To test it, first create
>a gif image with name test.gif in the same directory as show.pl (I
>attached that in two previous emails, but they did not arrive. So now I
>try without the gif-attachment).
>
>Can anybody explain what is wrong?

Yes - you are not ->delete ing the images you create.
Instead you are trying to ->destroy them which isn't a method of images
but is a Tcl/Tk inherited command. So it trys to 'destroy' a window (widget)
with same name as you image. It doesn't find one so does nothing.
->destroy does not produce an error message in such a case as during
close down it is quite normal for ->destroy to be called on a perl object
for which the core-Tk window has already been cleaned up.

So change code to $tmp->delete


>Is there a way to zoom a picture with
>a non-integer factor and not encountering this kind of problems?
>
>Thanks in advance, Ruud
>#!/usr/bin/perl -w
>use Tk;
>use strict;
>use Tk::Photo;
>
>my $main = MainWindow->new(-title => "test");
>my $f = $main->Frame()->pack();
>
>my $c = $f->Scrolled('Canvas', -width => '15c',  -height => '20c',
>    -scrollregion => [qw/0c 0c 30c 44c/])->pack(qw/-expand yes -fill both/)
;
>
>my $photo_original = $main->Photo (-file => 'kerstkaart03.gif');
>my $scaled_photo;
>scale_foto ($c, 1, 1);      # $scaled_photo will be assigned the new photo
>my $w = $c->Label (-image => $scaled_photo)->pack ();
>$c->createWindow (5, 5, -width => $scaled_photo->image('width'),
>			-height => $scaled_photo->image('height'),
>			-anchor => 'nw', -window => $w,
>			-tags => 'window');
>
>$f->Button (-text => 'OK', -command => sub {exit;})->pack (-side => 'bottom
');
>$f->Button (-text => '+', -command =>
>	sub {   scale_foto ($c, 15, 13);
>			$w->configure (-image => $scaled_photo);
>			$c->itemconfigure ('window',
>				-width => $scaled_photo->image('width'),
>				-height => $scaled_photo->image('height'));
>                })->pack (-side => 'bottom');
>$f->Button (-text => '-', -command =>
>	sub {   scale_foto ($c, 13, 15);
>			$w->configure (-image => $scaled_photo);
>			$c->itemconfigure ('window',
>				-width => $scaled_photo->image('width'),
>				-height => $scaled_photo->image('height'));
>                })->pack (-side => 'bottom');
>MainLoop;
>
>sub scale_foto
>{
>    my ($canvas, $t, $n) = @_;
>
>    my $foto_scale;
>   # perform zooming first
>	my $width = $photo_original->image('width');
>	my $height = $photo_original->image('height');
>	my $tmp = $canvas->Photo (-width => $width * $t,
>								-height => $height * $t);
>	$tmp->copy ($photo_original, -zoom => ($t));
>	if ($n == 1)
>	{   # no subsampling either for scale a/1
>		$foto_scale = $tmp;
>	}
>	else
>	{   # shrink zoomed photo again to get the desired scale
>		$foto_scale = $canvas->Photo (-width => $width * $t / $n,
>									-height => $height * $t / $n);
>		$foto_scale->copy ($tmp, -subsample => ($n));
>		$tmp->destroy ();
>	}
>    # destroy allready existing scale photo
>    $scaled_photo->destroy () if (defined ($scaled_photo));
>    # and replace it with the newly made
>    $scaled_photo = $foto_scale;
>}


-++**==--++**==--++**==--++**==--++**==--++**==--++**==
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the
message body of "unsubscribe ptk" to majordomo@lists.stanford.edu