Re: Tk::Photo question

On Wed, 23 May 2007 19:16:27 GMT, QoS@xxxxxxxxxxxxxx wrote:

While I am not getting errors.. the images also are not zooming.

Here is the sub that loads images onto the widget
The load_image sub that is referred to simply holds the Base64 encoded
images.

Even though you showed code, I can't run it. But here is
a script that works, you may have come across it from a google
search, but see how he does it.

Personally, I find the Tk::Photo object pretty slow and weak for
transformations, and usually use Image::Magick or Imager for that
stuff.


#!/usr/bin/perl
# tkjpegZoom
# Author: Martin Herrmann
# Email: Martin-Herrmann@xxxxxx
# Date: 28.07.2003

# this is a little Perl/Tk application to play around with the
# Tk::JPEG module and the zoom and subsample options
# the duration of the zoom and subsampling function are taken
# with Time::HiRes and displayed as text and in a diagram

# the time to zoom a photo object is nearly only dependent on the
# -zoom value, the subsampling is quite fast

use strict;
use Tk;
use Tk::JPEG;
use Image::Info qw(image_info dim);
use Time::HiRes qw(gettimeofday tv_interval);

die "usage $0 image.jpg\n" if (@ARGV <= 0);
die "$ARGV[0] is no file!\nusage $0 image.jpg\n" if (! -f $ARGV[0]);

my $ii = image_info($ARGV[0]);
my ($w, $h) = dim($ii);
print "image $ARGV[0] x:$w y:$h\n";

# create window and some frames
my $top = MainWindow->new;
my $fr = $top->Frame()->pack(-expand => 1, -fill => "x");
my $update = 0;
$top->Checkbutton(-text => "auto update", -variable =>
\$update)->pack();
my $fm = $top->Frame()->pack(-expand => 1, -fill => "x");
my $photo;
my $zoom = 1;
my $zoomf = "100%";
my $subsample = 5;

# create some Labels, Scales, Buttons, ...
$fr->Label(-textvariable => \$zoomf)->pack(-side => "left");

$fr->Scale(-label => "Zoom",
-variable => \$zoom,
-troughcolor => "red",
-from => 1,
-to => 50,
-resolution => 1,
-orient => 'horizontal',
-showvalue => 1,
-command => sub {return unless ($update); zoom($zoom,
$subsample); }
)->pack(-side => "left", -expand => 1, -fill => "x");

$fr->Scale(-label => "Subsample",
-variable => \$subsample,
-troughcolor => "blue",
-from => 1,
-to => 50,
-resolution => 1,
-orient => 'horizontal',
-showvalue => 1,
-command => sub {return unless ($update); zoom($zoom,
$subsample); }
)->pack(-side => "left", -expand => 1, -fill => "x");

$fr->Button(-text => "zoom!",
-command => sub { zoom($zoom,
$subsample);})->pack(-side => "left", -expand => 1, -fill => "both");

$fr->Button(-text => "+",
-command => sub { $zoom++; $subsample++;
zoom($zoom, $subsample);})->pack(-side => "left", -expand => 1, -fill =>
"both");

$fr->Button(-text => "-",
-command => sub { $zoom--; $subsample--;
zoom($zoom, $subsample);})->pack(-side => "left", -expand => 1, -fill =>
"both");

$fr->Button(-text => "exit",
-command => \&exit,)->pack(-side => "left",
-expand => 1, -fill => "both");

# the canvas shows the time needed for zooming and subsampling (y-scale)
# the x-scale is the sum of zoom and subsample factor
my $c = $fm->Canvas(-width => 120,
-height => 120,
-relief => 'sunken',
-bd => 2)->pack(-side =>
"left");
my $yscale = 5;
$fm->Scale(-label => "y scale",
-variable => \$yscale,
-from => 1,
-to => 200,
-resolution => 1,
-orient => 'vertical',
-showvalue => 1,
-command => sub {
$c->delete("all"); # delete all items in the
canvas
}
)->pack(-side => "left");

my $lb = $fm->Scrolled("Listbox",
-scrollbars => 'osoe',
-selectmode => 'none',
-exportselection => 0,
-width => 30,
-height => 8,
)->pack(-expand => 1, -fill
=>'both', -padx => 2, -pady => 2);

$lb->insert('end', " zoom subsample");
$lb->insert('end', " fac time(s) fac time(s)");

my $l = $top->Label()->pack();

# make the first zooming
zoom($zoom, $subsample);

$top->MainLoop;

exit;

sub zoom {
my $zoom = shift;
my $subsample = shift;

$top->Busy; # show a busy pointer while zooming

# delete the photo object
$photo->delete if ($photo);

# do some time messurement
my $start = [gettimeofday];

# (re)load picture
$photo = $top->Photo(-file => "$ARGV[0]");

# open blank photo object (for temporary use)
my $zoomed = $top->Photo;
$zoomed->blank;

my $step2 = [gettimeofday];

# zoom the picture
$zoomed->copy($photo, -zoom => $zoom);

my $step3 = [gettimeofday];

# delete the original photo
$photo->delete;
$photo = undef;
$photo = $top->Photo;
$photo->blank;

my $step4 = [gettimeofday];

# subsample the zoomed photo to the original photo
$photo->copy($zoomed, -subsample => $subsample);

my $step5 = [gettimeofday];

# delete the temporary photo object
$zoomed->delete;
$zoomed = undef;

$l->configure(-image => $photo);
$l->update;

# calculate the durations and zoom factor
my $end = [gettimeofday];
my $compdur = tv_interval ($start, $end);
my $compdur1 = tv_interval ($step2, $step3);
my $compdur2 = tv_interval ($step4, $step5);
my $procent = int($zoom/$subsample*100);
$zoomf = "$procent%";

# show the zoomfactor (zoom/subsample), the zoom and the subsample
value and duration in the listbox
$lb->insert('end', sprintf("%4s: %2d %-8s %2d %-8s", $zoomf, $zoom,
$compdur1, $subsample, $compdur2));
$lb->see('end');

# draw the values as point in the canvas
draw(($zoom + $subsample),int($yscale * $compdur1), "red");
draw(($zoom + $subsample),int($yscale * $compdur2), "blue");

$top->Unbusy;
}

sub draw {
my ($x, $y, $col) = @_;
# invert the y scale
$y = $c->height - $y - 5;
# make a boundary check
$x = ($c->width - 3) if ($x > ($c->width - 3));
$x = 3 if ($x < 3);
$y = ($c->height - 3) if ($y > ($c->height - 3));
if ($y < 3) { $y = 3; $col = "yellow"; }
$c->createRectangle( $x, $y, ($x+1), ($y+1),
-outline => $col,
-fill => $col,
);
}

__END__


--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html
.