# tkjpegZoom # Author: Martin Herrmann # Email: Martin-Herrmann@gmx.de # 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, ); }