#!/usr/bin/perl -w # Part of a bunch of stuff for making thumbnail images, e.g. for a web # gallery. Despite the name, this is merely a half-assed image viewer # that allows you to rotate the image 'in place'. In fact, it calls a # script to do that, too. Jeez. Talk about kludges. # Waider Feb 2001 use Tk; use Tk::Image; $m = MainWindow->new( -title=>"ImageViewer" ); # Bindings. $m->bind( '', sub { rotateimage(); }); $m->bind( '', sub { setimage( nextimage()); }); $m->bind( '', sub { exit(); }); my $img = nextimage(); my $pic; my $blarg = $m->Label()->pack(); setimage( $img ); MainLoop; sub setimage { my $img = shift; # get image type my $imgtype = `file $img`; # clean it up chomp( $imgtype ); $imgtype =~ s/^.*?:\s+(\w+)\s+.*$/\L$1/; $m->configure( -title=>"$img" ); # we can only natively handle GIFs and PNMs; it appears that # registering new handlers requires C. So. if ( $imgtype eq "jpeg" ) { my $newimg = "/tmp/$$.img"; `djpeg "$img" > "$newimg"`; $img = $newimg; } $pic = $m->Photo( -file=>"$img" ); $blarg->configure( -image=>$pic ); } sub nextimage { do { $img = shift @ARGV || exit; # bail if it's the last image } while( !-f $img ); $img; } sub rotateimage { `rotate.sh "$img"`; setimage( $img ); }