use Tk; use Tk::JPEG; use File::Glob ':glob'; my $automode = 0; my @jpgs = bsd_glob("9???.jpg"); my $index = -1; my $mw = MainWindow->new(title => "JPEG"); $mw->geometry("800x800"); my $f = $mw->Frame()->pack(-fill => "both"); $f->Button(-text => "Load", -command => \&load)->pack(-side => "left", -fill => "both"); my $pattern = $f->Entry(-width => 10, -text => '*')->pack(-side => "left", -fill => "both"); my $step; $f->Button(-text => "<<", -command => sub {prev_image($step->get())})->pack(-side => "left", -fill => "both"); $f->Button(-text => "<", -command => sub {prev_image(0)})->pack(-side => "left", -fill => "both"); $step = $f->Entry(-width => 3, -text => 10)->pack(-side => "left", -fill => "both"); $f->Button(-text => ">", -command => sub {next_image(0)})->pack(-side => "left", -fill => "both"); $f->Button(-text => ">>", -command => sub {next_image($step->get())})->pack(-side => "left", -fill => "both"); $f->Checkbutton(-text => "Auto Mode", -onvalue => 1, -offvalue => 0, -variable => \$automode, -command => sub {if ($automode) {print $automode; next_image()}})->pack(-side => "left", -fill => "both"); $f->Label(-text => "Delay")->pack(-side => "left", -fill => "both"); my $delay = $f->Entry(-width => 4, -text => 1000)->pack(-side => "left", -fill => "both"); $f->Label(-text => "milli-second(s)")->pack(-side => "left", -fill => "both"); my $image = $mw->Photo(); next_image(0); my $button = $mw->Label(-image => $image)->pack(-side => "top", -fill => "both"); MainLoop; sub load { @jpgs = bsd_glob($pattern->get()); $index = -1; next_image(0); } sub next_image { $index += shift; $index = $#jpgs if ($index > $#jpgs); while ((($index + 1)<= $#jpgs) && !eval {$image->read($jpgs[++ $index], -shrink); 1}) { } if ($automode) { $mw->after($delay->get(), \&next_image) if (($index + 1) <= $#jpgs); } $mw->configure(-title => $jpgs[$index]); $std = undef; } sub prev_image { $index -= shift; $index = 0 if ($index < 0); $automode = 0; while ((($index - 1) >= 0) && !eval {$image->read($jpgs[-- $index], -shrink); 1}) { } if ($index >= 0) { $mw->configure(-title => $jpgs[$index]); $std = undef; } }