#!/pro/bin/perl

use strict;
use warnings;

{   # to_background
    my $pid = fork;
    if ($pid < 0) {
	print STDERR "Unable to run in the background, cannot fork: $!\n";
	exit $?;
	}
    $pid and exit 0;
    } # to_background

our $VERSION = 0.044;

my %Option = (
    thumbsize		=> 80,		# in pixels
    thumbrows		=> 5,
    thumbposition	=> "se",
    thumbsorting	=> "default",
    thumbsortorder	=> "ascending",
    imageposition	=> "nw",
    imagedir		=> ".",
    slideshowdelay	=> 1500,	# in milliseconds
    slideposition	=> "c",
    slidefull		=> 0,
    slidecover		=> 0,
    slideshowloop	=> 1,
    maxx		=> 9999,
    maxy		=> 9999,
    smallfont		=> "-misc-fixed-medium-r-normal--7-70-75-75-c-50-iso10646-1",
    confirmdelete	=> 1,
    removetarget	=> 0,
    imagefull		=> 0,
    decoration		=> 1,

    keys_quit		=> [qw( Key-q Escape Shift-Q	)],
    keys_options	=> [qw( Key-o			)],
    keys_firstpic	=> [qw( Key-0 Key-1  Key-a	)],
    keys_prevpic	=> [qw( Left  Up     BackSpace	)],
    keys_nextpic	=> [qw( Right Down   space	)],
    keys_lastpic	=> [qw( Key-9 Key-z		)],
    keys_fullscreen	=> [qw( Key-f F11		)],
    keys_fitwidth	=> [qw( Key-b			)],
    keys_fitheight	=> [qw( Key-h			)],
    keys_origsize	=> [qw( Key-o			)],
    keys_full_rc	=> [qw( Key-F			)],
    keys_rotleft	=> [qw( Key-l			)],
    keys_rotexifl	=> [qw( Key-L			)],
    keys_rotright	=> [qw( Key-r			)],
    keys_rotexifr	=> [qw( Key-R			)],
    keys_zoomin		=> [qw( plus			)],
    keys_zoomout	=> [qw( minus			)],
    keys_delete		=> [qw( Delete			)],
    keys_slideshow	=> [qw( Key-w Key-s		)],
    keys_exif		=> [qw( Key-i			)],
    keys_decoration	=> [qw( Key-d			)],

    keys_imgpos_nw	=> [qw( Alt-u			)],
    keys_imgpos_n	=> [qw( Alt-i			)],
    keys_imgpos_ne	=> [qw( Alt-o			)],
    keys_imgpos_e	=> [qw( Alt-l			)],
    keys_imgpos_se	=> [qw( Alt-period		)],
    keys_imgpos_s	=> [qw( Alt-comma		)],
    keys_imgpos_sw	=> [qw( Alt-m			)],
    keys_imgpos_w	=> [qw( Alt-j			)],
    keys_imgpos_c	=> [qw( Alt-k			)],
    );

sub usage
{
    my ($show_opt) = (@_, 0);
    print STDERR "usage: iv.pl [-f] [option=value ...] [dir]\n";
    if ($show_opt) {
	foreach my $o (sort keys %Option) {
	    my $v = $o =~ m/^keys_/ ? "(".(join" ",@{$Option{$o}}).")" : $Option{$o};
	    my $alt = {
		imageposition  => "\t\t(nw n ne e se s sw w c)",
		slideposition  => "\t\t(nw n ne e se s sw w c)",
		thumbposition  => "\t\t(nw n ne e se s sw w c)",
		thumbsorting   => "\t(default caseless date size random)",
		thumbsortorder => "\t(ascending descending)",
		}->{$o} || "";
	    printf STDERR "  %-15s %s%s\n", $o, $v, $alt;
	    }
	}
    exit 0;
    } # usage

# TODO: * save/load from .ivrc buttons on option window
#	* Slideshow behaviour: location, dir depth, cycling
#	  randomness, slide lists, full screen background (no decoration)
#	* Slideshow play list
#	* Slideshow loop control
#	* Image manipulation
#	  - Crop
#	  - Save, save as
#	* Titles and decoration behaviour
#	  - adjust height/width of screen-fit images to decoration
#	    I just cannot get $iv->overrideredirect (1) to work as I want
#	* Hide dirs above dt root
#	  - Allow a set of dirs from the command line
#	* use Tk::Animation for animated gif's
#	* Menu's ?
#	* Auto-sense image load time for slideshows
#	* Move onward to App::tkiv (with iv => tkiv link)

# Filter out the irfanview options that I don't support
@ARGV = grep { !m{^/(hide|thumbs?)(=\d+)?$} } @ARGV;
@ARGV == 1 and $ARGV[0] =~ m/^-[h?]$/         and usage (0);
@ARGV == 1 and $ARGV[0] =~ m/^-+(help|info)$/ and usage (1);

use Getopt::Long qw(:config bundling nopermute passthrough);
my $opt_f = 0;	# Start with full-screen pics
my $opt_v = 0;	# Verbosity / debug
my $opt_s = 0;	# Start slideshow immediately
GetOptions (
    "v:1" => \$opt_v,
    "f"   => \$opt_f,
    "s"   => \$opt_s,
    ) or usage (0);

use Cwd qw( realpath );
use Tk;
use Tk::JPEG;
use Tk::PNG;
use Tk::Bitmap;
use Tk::Pixmap;
use Tk::Photo;
use Tk::Pane;
use Tk::DirTree;
use Tk::Dialog;
use Tk::Balloon;
use Tk::BrowseEntry;
use Tk::Animation;
use X11::Protocol;
use Data::Dumper; $Data::Dumper::Sortkeys = 1;
use File::Copy;

our $exiftool = 0;
our $iinftool = 0;
our $imsztool = 0;
our $exiftran = 0;
eval {
    use Image::ExifTool qw( ImageInfo );
    $exiftool = Image::ExifTool->new ();
    use Image::Size	qw( imgsize );
    $imsztool = exists &imgsize;
    use Image::Info	qw( image_info dim );
    $iinftool = exists &image_info;
    -x "/usr/bin/exiftran" and $exiftran = 1;
    };

my $pic = @ARGV && -f $ARGV[-1] && $ARGV[-1] =~ s{/([^/]+)$}{} ? $1 : "";

{   my @opt;
    my @ivrc_dirs = ("/etc", $ENV{HOME});
    @ARGV && -d $ARGV[-1] and push @ivrc_dirs, $ARGV[-1];
    foreach my $dir (@ivrc_dirs) {
	-d $dir or next;
	open my $of, "<", "$dir/.ivrc" or next;
	while (<$of>) {
	    m/^[#!]/		and next;
	    s/\s+$//;
	    m/^\S+\s*=\s*\S/	or  next;
	    push @opt, $_;
	    }
	close $of;
	}
    foreach my $opt (split m/[:;]/ => $ENV{IVRC} // "") {
	$opt =~ s{^[-/]?(\S+\s*=\s*\S.*)}{$1} or next;
	push @opt, $opt;
	}
    while (@ARGV && $ARGV[0] =~ s{^[-/]?(\S+\s*=\s*\S.*)}{$1}) {
	push @opt, shift @ARGV;
	}
    for (@opt) {
	m/^(\S+)\s*=\s*(\S.*)/	or next;
	my ($opt, $val) = (lc $1, $2);
	$opt =~ m/^keys_/ and $val = [ split m/\s+/, $val ];
	$Option{$opt} = $val;
	}
    }
foreach my $k (grep m/^keys_/ => keys %Option) {
    s/^<?(.*?)>?$/<$1>/ for @{$Option{$k}};
    }
$opt_f ||= $Option{imagefull};

my $dir = @ARGV ? shift @ARGV : $Option{imagedir};
-d $dir or die "$dir is not a (valid) dir\n";
my $tpx = $Option{thumbsize};	# Max edge size for thumbs
my $tnx = $Option{thumbrows};	# Max nr of tn's horizontal

my $f_small = $Option{smallfont};
my $def_sls = $Option{slideshowdelay}; # 1.5 sec / pic

# Screen dimensions
my $x11 = X11::Protocol->new ();
$x11->choose_screen (0); # Root window
my ($cx, $cy) = ( $x11->{width_in_pixels}, $x11->{height_in_pixels} );
$cx > $Option{maxx} and $cx = $Option{maxx};
$cy > $Option{maxy} and $cy = $Option{maxy};
$cy -= 52; # Toolbar and Window decoration

# Globals
my ($idir, @tn, $ti, $ni);	# ImageDir, ThumbNails, ThumbIndex, NumberOfImages
my ($tr, $or, $fr, $zs);	# ThumbsRead, OrigRead, FullRead, ZoomState

# Main Window
my $mw = Tk::MainWindow->new (-title => "iv");

# The thumbnail browser
my ($dt, $tn, $tg, $ow);	# DirTree, ThumbNails, ThumbnailGrid, OptionWindow
my ($sls, $f11) = (0);		# SlideShow, Image callback

# The image browser
my ($vs, $iv, $bg) = (0);	# Viewer state: original (0) or full screen (1)
my ($tp, $ip, $sp) = @Option{qw( thumbposition imageposition slideposition )};

# Default pack option
my @dpo =  qw( -expand 1 -fill both );

# Positioning
my (@loc, %loc) = qw( nw n ne e se s sw w c );
@loc{@loc} = qw( +2+2 +X+2 -2+2 -2+Y -2-2 +X-2 +2-2 +2+Y +X+Y +X+Y );
sub loc
{
    my $loc = $loc{shift @_};
    my ($ww, $wh) = (@_, 0, 0);
    if ($loc =~ m/[XY]/) {
	my ($x, $y) = map {
	    my $c = int ($_ / 2);
	    $c < 2 ? 2 : $c;
	    } ($cx - $ww - 15, $cy - $wh);
	$loc =~ s/X/$x/;
	$loc =~ s/Y/$y/;
	}
    $loc;
    } # loc

sub bind_wheel
{
    my ($w, $sw, $u) = @_;
    $w->bind ("<4>",            sub { $sw->yview (scroll => -$u, "units") });
    $w->bind ("<5>",            sub { $sw->yview (scroll =>  $u, "units") });
    $w->bind ("<Alt-Button-4>", sub { $sw->xview (scroll => -$u, "units") });
    $w->bind ("<Alt-Button-5>", sub { $sw->xview (scroll =>  $u, "units") });
    } # bind_wheel

my $pxyid = 10000;
sub Tk::PhotoXY
{
    my ($w, $f, $x, $y, $r, $p) = (@_, 0);
    $f && $x && $y or return;
    my $rot = $r ? "-rotate $r " : "";
    my $cfn = "/tmp/iv#$$-".$pxyid++;
    my ($rx, $ry) = $r == 90 || $r == 270 ? ($y, $x) : ($x, $y);
    my $geo = "${rx}x${ry}";
    my $q = $f =~ m/'/ ? '"' : "'";
    system qq{convert -size $geo -resize $geo+0+0 $rot $q$f$q $cfn.jpg};
    # convert generates multiple files for animated images
    my @cfn = glob "${cfn}*jpg*";
    if (@cfn) {
	$p = $w->Photo (-file => $cfn[0]);
	unlink @cfn;
	}
    $p;
    } # PhotoXY

sub show_exif
{
    my $exif = shift or return;
    my $tl = $mw->Toplevel (-title => "Image EXIF info");
    $ow = $tl->Scrolled ("Frame",
	-scrollbars => "osoe",
	-width      => 650,
	-height     => int ($cy * .65))->grid (-sticky => "nsew");
    $ow->Subwidget ("${_}scrollbar")->configure (-width => 6) for qw( x y );
    $ow->gridRowconfigure    (0, -weight => 1); # allow expansion in both ...
    $ow->gridColumnconfigure (0, -weight => 1); # ... X and Y dimensions
    my @exif = sort { lc $a cmp lc $b } keys %$exif;
    my $half = int (@exif / 2);
    foreach my $row (0 .. ($half - 1)) {
	$ow->Label (
	    -text   => $exif[$row],
	    -anchor => "w",
	    -fg     => "DarkGreen",
	    -font   => $Option{smallfont},
	    )->grid (-row => $row, -column => 0, -sticky => "news");
	$ow->Label (
	    -text   => $exif->{$exif[$row]},
	    -anchor => "w",
	    -fg     => "DarkBlue",
	    -font   => $Option{smallfont},
	    )->grid (-row => $row, -column => 1, -sticky => "news");
	$row + $half > $#exif and last;
	$ow->Label (
	    -text   => $exif[$row + $half],
	    -anchor => "w",
	    -fg     => "DarkGreen",
	    -font   => $Option{smallfont},
	    )->grid (-row => $row, -column => 2, -sticky => "news");
	$ow->Label (
	    -text   => $exif->{$exif[$row + $half]},
	    -anchor => "w",
	    -fg     => "DarkBlue",
	    -font   => $Option{smallfont},
	    )->grid (-row => $row, -column => 3, -sticky => "news");
	$row++;
	}
    # Destroy
    foreach my $W ($ow, $tl) {
	$W->bind ($_, sub {
	    if (Exists ($ow)) { $ow->destroy; $ow = undef; }
	    if (Exists ($tl)) { $tl->destroy; $tl = undef; }
	    }) for @{$Option{keys_quit}};
	}
    } # show_exif

sub options
{
    my $tl = $mw->Toplevel (-title => "IV options");
    $ow = $tl->Frame ()->grid (-sticky => "nsew");
    $ow->gridRowconfigure    (0, -weight => 1); # allow expansion in both ...
    $ow->gridColumnconfigure (0, -weight => 1); # ... X and Y dimensions
    my $row = 0;
    for ([ "Thumb columns",		\$tnx ],
	 [ "Thumb size",		\$tpx ],
	 [ "Thumb sort method",		\$Option{thumbsorting},   qw( default caseless date size random )],
	 [ "Thumb sort order",		\$Option{thumbsortorder}, qw( ascending descending )],
	 [ "Image position",		\$ip, @loc ],
	 [ "Remove symlink target",	\$Option{removetarget} ],
	 [ "Slideshow",			\$sls ],
	 [ "Slideshow delay",		\$def_sls  ],
	 [ "Slideshow position",	\$sp, @loc ],
	 [ "Slideshow img size",	\$Option{slidefull},  qw( 0 1 ) ],
	 [ "Slideshow full screen",	\$Option{slidecover}, qw( 0 1 ) ],
	 ) {
	my ($label, $var, @val) = @$_;
	$ow->Label (
	    -text         => $label,
	    -anchor       => "w",
	    -fg           => "DarkGreen",
	    )->grid (-row => $row, -column => 0, -sticky => "news");
	if (@val) {
	    my $cmd = sub { 1; };
	    my $be = $ow->BrowseEntry (
		-width              => 12,
		-borderwidth        =>  1,
		-highlightthickness =>  1,
		-listwidth          => 40,
		-variable           => $var,
		-browsecmd          => $cmd,
		)->grid (-row => $row, -column => 1, -sticky => "news");
	    $be->insert ("end", $_) for @val;
	    }
	else {
	    $ow->Entry (
		-textvariable => $var,
		-width        => 12,
		)->grid (-row => $row, -column => 1, -sticky => "news");
	    }
	$row++;
	}
    $ow->Button (-text => "OK",    -fg => "DarkGreen",
	-command => sub { $ow->destroy; $ow = undef ; $tl->destroy; dtcmd ($idir) },
	)->grid (-row => $row, -column => 0, -sticky => "news");
    $ow->Button (-text => "Apply", -fg => "DarkGreen",
	-command => sub { dtcmd ($idir) },
	)->grid (-row => $row, -column => 1, -sticky => "news");
    } # options

my %tsort = (
   # [ Name, seq, size, mtime, lc name ]

    # 1. numeric part of image name, 2. image name
    default	=> sub { $a->[1] <=> $b->[1] || $a->[0] cmp $b->[0] },

    # 2. size
    size	=> sub { $a->[2] <=> $b->[2] },

    # 3. date
    date	=> sub { $a->[3] <=> $b->[3] },

    # 4. caseless image name
    caseless	=> sub { $a->[4] cmp $b->[4] },

    # 5. random
    random	=> sub { $a->[5] <=> $b->[5] },
    );

my $refreshing = "";
sub dtcmd
{
    # trigger $tn to show thumbnails of all pics in current dir
    # Expansion also invokes this callback
    @_ == 1                or return;
    $idir = realpath $_[0] or return ($refreshing = "");
    $refreshing eq $idir  and return;
    $refreshing = $idir;

    # Clean up previous pics
    $iv && Exists ($iv) and $iv->destroy;
#   $bg && Exists ($bg) and $bg->destroy;
    for (@tn) {
	$_ && ref $_ && $_->{wdgt} && Exists ($_->{wdgt}) and
	    $_->{wdgt}->destroy ();
	}
    # New dir, reset globals
    ($tr, $or, $fr, $ti, $vs, $sls, $zs, $f11, @tn) = (0, 0, 0, -1, $opt_f, 0);

    (my $ttl = $idir) =~ s{^$ENV{HOME}}{~};
	$ttl =~ s{^~/\.wine/fake_windows/}{:};
    utf8::upgrade ($ttl);
    $mw->title ($ttl);

    my $tb = $tg->Balloon (
	-state      => "balloon",
	-initwait   => 1200,		# 1.2 ms
	-foreground => "Blue4",
	-background => "LightYellow2");

    # Gather all pics in this folder
    opendir IDIR, $idir;
    my @img = map  { $_->[0] }
	      sort { $tsort{$Option{thumbsorting}}->() }
	      map  { my $seq = m/(\d+)/ ? $1 : 0;
	             [ $_, $seq, (stat"$idir/$_")[7,9], lc $_, rand 1 ] }
	      grep { my $s = -s "$idir/$_"; $s and $s > 100 } # Sanity check. Minimal image size 100
	      # convert can't deal with .ico files (yet)
	      # Tk Cannot deal with Tiff (yet)
	      grep m/\.(jpe?g|gif|x[pb]m|png|bmp)$/i => readdir IDIR;
    closedir IDIR;
    $Option{thumbsortorder} =~ m/^(?:desc|reverse)/ and @img = reverse @img;

#my $t0 = [ gettimeofday ];
    $ni = @img;
    $opt_v and print STDERR "$ni images in $idir\n";
    foreach my $img (@img) {
	my $nt = @tn;

	my $pf = "$idir/$img";
	my $ps = -s $pf or next;
	my $data;

	$opt_v and print STDERR "Read $pf ($ps) ...\n";
	# Read it
	my ($exif, $angl, $x, $y, $o) = ({}, 0, 0, 0);
	if ($exiftool) {
	    $exif = ImageInfo ($pf);
	    #print STDERR Dumper $exif;
	    if (ref $exif and exists $exif->{ImageWidth}) {
		($x, $y) = ($exif->{ImageWidth}, $exif->{ImageHeight});
		my $ori = $exif->{Orientation} // "Horizontal";
		delete $exif->{$_} for qw( ThumbnailImage PreviewImage DataDump );
		$ori =~ m/\b(-?\d+)\b/ and $angl = $1;
		$angl < 0 and $angl += 360;
		$exif->{Animated} = 0;
		if ($exif->{FileType} eq "GIF" && $iinftool) {
		    my $info = image_info ($pf);
		    $exif->{Animated} = $info->{Delay} // 0;
		    }
		}
	    }
	if ($x == 0 and $imsztool) {
	    my ($w, $h) = imgsize ($pf);
	    $w and ($x, $y) = ($w, $h);
	    }
	if ($x == 0 and $iinftool) {
	    my (@info) = image_info ($pf);
	    @info && ref $info[0] eq "HASH" && exists $info[0]{width} and
		($x, $y) = ($info[0]{width}, $info[0]{height});
	    }
	if ($x == 0) {
	    my $q = $pf =~ m/'/ ? '"' : "'";
	    my ($w, $h) = `identify -format "%w,%h" -quiet $q$pf$q` =~ m/([0-9]+)/g;
	    $w and ($x, $y) = ($w, $h);
	    }
	$x && $y or next;

	# Full screen
	my ($fx, $fy) = ($cx / $x, $cy / $y);
	my $ff = $fx < $fy ? $fx : $fy;
	my ($fX, $fY) = map { int } ($ff * $x, $ff * $y);

	# Thumbnail
	my ($rx, $ry) = $angl == 90 || $angl == 270 ? ($y, $x) : ($x, $y);
	my $tf = $tpx / ($ry > $rx ? $ry : $rx);
	my ($tX, $tY) = map { int } ($tf * $rx, $tf * $ry);

	my $t = $tn->PhotoXY ($pf, $tX, $tY, $angl);
	$tr++;

	my $w = $tg->Label (-image => $t)->grid (
	    -row    => int ($nt / $tnx),
	    -column => $nt % $tnx,
	    -sticky => "news",
	    );

	my $titl = $img;
	utf8::upgrade ($titl);
	push @tn, {
	    wdgt => $w,		# Widget
	    angl => $angl,	# rotation angle
	    phys => {		# Physical location and size
		file => $pf,
		dir  => $idir,
		titl => $titl,
		size => $ps,
		},
	    orig => {		# Original picture
		phot => $o,
		wdth => $x,
		hght => $y,
		},
	    thmb => {		# Thumbnail
		phot => $t,
		wdth => $tX,
		hght => $tY,
		},
	    full => {		# Full screen
		phot => undef,
		wdth => $fX,
		hght => $fY,
		},
	    exif => $exif,
	    };

       # $f11->($w [, $vs [, $ti [, $trigger]]]);
       $f11 = sub {
	    my $self = @_ && ref $_[0] ? shift (@_) : undef;
	    my $fs   = @_ ? shift (@_) : ($vs ^= 1, $vs);
	    @_ and $ti  = shift @_;
	    my $trg = @_ ? shift @_ : "";

	    $iv && Exists ($iv) and $iv->destroy;
#	    $bg && Exists ($bg) and $bg->destroy;

	    my $aid;			# last stacked After ID
	    my $pr   = $tn[$ti];
	    my $size = $fs =~ m/^1$/ ? "full" : $fs =~ m/^\d\d+$/ ? $fs : "orig";
	    for ($pr->{$size}{phot}) {
		defined and last;

		if ($size eq "orig" && !$pr->{angl}) {
		    if (exists $pr->{exif}{Animated} && $pr->{exif}{Animated}) {
			$pr->{$size}{phot} = $tn->Animation (-file => $pr->{phys}{file});
			}
		    else {
			$pr->{$size}{phot} = $tn->Photo (-file => $pr->{phys}{file});
			}
		    $or++;
		    last;
		    }

		if ($size =~ m/^\d\d+$/) {
		    @{$pr->{$size}}{qw( wdth hght )} =
			map { int ($size * $_ / 100) } @{$pr->{orig}}{qw( wdth hght )};
		    }

		$pr->{$size}{phot} = $tn->PhotoXY ($pr->{phys}{file},
		    @{$pr->{$size}}{qw( wdth hght )}, $pr->{angl} // 0);
		$fr++;
		}
	    my $zoom = $pr->{$size}{hght} > $cy || $pr->{$size}{wdth} > $cx ? 1 : 0;

	    if ($sls && $Option{slidecover} && !$bg) {
		$bg = $mw->Toplevel (-bg => "Black");
		$bg->geometry ("${cx}x${cy}+0+0");
#		$bg->overrideredirect (1);
		$bg->update;
		}
	    $iv = $mw->Toplevel (-title => $pr->{phys}{titl});
	    $iv->geometry (loc ($sls ? $sp : $ip, $pr->{$size}{wdth}, $pr->{$size}{hght}));

	    my $pw = $iv;
	    if ($zoom) {
		$pw = $iv->Scrolled ("Frame",
		    -scrollbars => "osoe",
		    -width      => $pr->{$size}{wdth} + 15,
		    -height     => $pr->{$size}{hght})->pack (@dpo);
		$pw->Subwidget ("${_}scrollbar")->configure (-width => 6) for qw( x y );
		}
	    my $fp = $pw->Label (-image => $pr->{$size}{phot})->pack (@dpo);
	    $zoom and bind_wheel ($fp, $pw->Subwidget ("scrolled"), 10);

	    # indicate this pic in the thumbview
	    $tn[$_]{wdgt}->configure (-bg => "Gray") for 0 .. $#tn;
	      $pr->{wdgt}->configure (-bg => "Black");

	    $fp->update;
	    ref $pr->{$size}{phot} eq "Tk::Animation" and
		$pr->{$size}{phot}->start_animation ();#$pr->{exif}{Animated});
	    #$iv->focusForce;

	    my ($_pic, $_next_pic);
	    $_pic = sub {
		@tn or return;
		$ti = shift;
		$sls and $aid = $mw->after ($sls, $_next_pic);
		$f11->($vs);
		}; # next_pic

	    $_next_pic = sub {
		if ($aid) {
		    $aid->cancel;
		    $aid = undef;
		    }
		$_pic->($ti == $#tn ? 0 : $ti + 1);
		}; # next_pic

	    my $_rotate = sub {
		$sls = 0;
		for (keys %$pr) {
		    $_ eq "thmb" and next;
		    my $p = $pr->{$_};
		    ref $p eq "HASH" && exists $p->{phot} and undef $pr->{$_}{phot};
		    }
		$pr->{angl} = ($pr->{angl} + $_[0]) % 360;
		$f11->($fs);
		}; # rotate

	    my $_zoom = sub {
		$sls = 0;
		$fs eq "1" and return;	# No zoom from Full-screen
		$fs eq "orig" and $fs = 100;
		$fs ||= 100;
		my $zf = int ($_[0] * $fs);
		# with 20% increase steps:
		for (qw( 1 2 3 4 5 7 9 11 14 17 21 26 32 39 47 57 69 83 100
		     120 144 172 206 247 296 355 426 511 613 735 882 1058 1269
		     1522 1826 2191 2629 3154 3784 4540 5448 6537 7844 9412 )) {
		    $zf <= ($_ * 1.12) and return $f11->($_);
		    }
		$f11->(11300);	# Max enlargement
		}; # zoom

	    foreach my $W ($fp, $pw, $iv) {
		$W && Exists ($W) or next;

		# Toggle Full-Screen
		$W->bind ($_, $f11) for @{$Option{keys_fullscreen}};

		# Go Full-Screen and store
		$W->bind ($_, sub {
		    $Option{imagefull} = 1;
		    if (open my $ivrc, ">>", "$idir/.ivrc") {
			print $ivrc "ImageFull\t= 1\n";
			close $ivrc;
			}
		    $f11->($vs = 1) }) for @{$Option{keys_full_rc}};

		# First pic
		$W->bind ($_, sub {
		    $sls = 0;
		    $_pic->(0);
		    }) for @{$Option{keys_firstpic}};

		# Next pic
		$W->bind ($_, sub {
		    $sls = 0;
		    $_next_pic->();
		    }) for @{$Option{keys_nextpic}};

		# Prev pic
		$W->bind ($_, sub {
		    $sls = 0;
		    $_pic->($ti == 0 ? $#tn : $ti - 1);
		    }) for @{$Option{keys_prevpic}};

		# Last pic
		$W->bind ($_, sub {
		    $sls = 0;
		    $_pic->($#tn);
		    }) for @{$Option{keys_lastpic}};

		# Destroy
		my $quit = sub {
		    $sls = 0; $zs = undef;
		    if ($aid) {
			$aid->cancel;
			$aid = undef;
			}
		    Exists ($fp) and $fp->destroy; $fp = undef;
		    Exists ($pw) and $pw->destroy; $pw = undef;
		    Exists ($iv) and $iv->destroy; $iv = undef;
		    Exists ($bg) and $bg->destroy; $bg = undef;
		    $mw->update;
		    #$mw->grab;
		    #$mw->focusForce;
		    #$dt->focusForce;
		    }; # sub_quit

		$W->bind ($_, $quit) for @{$Option{keys_quit}};

		# Rotate right
		$W->bind ($_, sub {
		    $_rotate->(90);
		    }) for @{$Option{keys_rotright}};

		# Rotate left
		$W->bind ($_, sub {
		    $_rotate->(-90);
		    }) for @{$Option{keys_rotleft}};

		if ($exiftool) {
		    my $ExifOrient = sub {
			my ($file, $o, %e) = @_;
			my $ro = "Rotate $o CW";
			$exiftool->ExtractInfo ($file, \%e);
			(my $conv = $file) =~ s/\b(pict|hpim|dsc[_fn])(\d+)/conv$1/i;
			$conv eq $file and $conv =~ s/(.*\.)/$1_conv/;
			$exiftool->SetNewValue ("Orientation" => $ro);
			$exiftool->SetNewValue ("Rotation"    => "Horizontal");
			if ($exiftool->WriteInfo ($file, $conv)) {
			    unlink $file;
			    if ($exiftran) {
				qx{exiftran -a -o '$file' '$conv'};
				unlink $conv;
				return 0;
				}
			    move $conv, $file;
			    return $o;
			    }

			my $wrn = $exiftool->GetValue ("Error");
			my $err = $exiftool->GetValue ("Warning");
			my $msg = "Cannot write converted file $conv:\n";
			$err and $msg .= "   $err\n";
			$wrn and $msg .= "   $wrn\n";
			print STDERR $msg;
			return 0;
			}; # ExifOrient

 		    # Rotate right
		    $W->bind ($_, sub {
			Exists ($fp) and $fp->destroy; $fp = undef;
			Exists ($pw) and $pw->destroy; $pw = undef;
			Exists ($iv) and $iv->destroy; $iv = undef;
			Exists ($bg) and $bg->destroy; $bg = undef;
			$_rotate->($ExifOrient->($pr->{phys}{file}, 90));
			}) for @{$Option{keys_rotexifr}};

		    # Rotate left
		    $W->bind ($_, sub {
			Exists ($fp) and $fp->destroy; $fp = undef;
			Exists ($pw) and $pw->destroy; $pw = undef;
			Exists ($iv) and $iv->destroy; $iv = undef;
			Exists ($bg) and $bg->destroy; $bg = undef;
			$_rotate->($ExifOrient->($pr->{phys}{file}, 270));
			}) for @{$Option{keys_rotexifl}};
		    }

		# Zoom in
		$W->bind ($_, sub {
		    $_zoom->(1.2);
		    }) for @{$Option{keys_zoomin}};

		# Zoom out
		$W->bind ($_, sub {
		    $_zoom->(0.8);
		    }) for @{$Option{keys_zoomout}};

		# Set image position
		foreach my $pos (@loc) {
		    my $key = "keys_imgpos_$pos";
		    exists $Option{$key} or next;
		    $W->bind ($_, sub {
			$ip = $pos;
			$f11->($fs);
			}) for @{$Option{$key}};
		    }

		# Original size & options
		if ($W == $pw or $W == $iv) {
		    $W->bind ($_, sub {
			$sls = 0;
			$f11->($fs = "orig");
			}) for @{$Option{keys_origsize}};
		    }

		# Fit width
		$W->bind ($_, sub {
		    $f11->(int (100 * $cx / $pr->{orig}{wdth}));
		    }) for @{$Option{keys_fitwidth}};

		# Fit height
		$W->bind ($_, sub {
		    $f11->(int (100 * $cy / $pr->{orig}{hght}));
		    }) for @{$Option{keys_fitheight}};

		# Delete Image
		$W->bind ($_, sub {
		    $sls and return;	# No delete during slide show
		    @tn && $ti >= 0 && $ti <= $#tn or return;
		    my $file = $pr->{phys}{file};
		    if ($Option{confirmdelete}) {
			my $d = $w->Dialog (
			    -title   => "Confirm delete",
			    -text    => "Do you want to remove $file?",
			    -bitmap  => "question",
			    -buttons => [qw( Yes No )],
			    -default_button => "No",
			    );
			$d->Show (-global) eq "Yes" or return;
			}
		    -l $file && $Option{removetarget} and unlink readlink $file;
		    unlink $file;
		    $quit->();
		    $tn[-1]{wdgt}->destroy;
		    foreach my $i (reverse (($ti + 1) .. $#tn)) {
			my $w = $tn[$i]->{wdgt} = $tn[$i - 1]{wdgt};
			$w->configure (-image => $tn[$i]{thmb}{phot});
			$w->update;
			}
		    $ni--;
		    $tr--;
		    $tn[$ti]{orig}{phot} and $or--;
		    $tn[$ti]{full}{phot} and $fr--;
		    splice @tn, $ti, 1;
		    $ti > $#tn and $ti--;
		    if (@tn) {
			$f11->($vs);
			}
		    else {
			$Option{removetarget} and rmdir $idir;
			$refreshing = "";
			-d $idir ? dtcmd ($idir) : dirup ();
			}
		    }) for @{$Option{keys_delete}};

		# Options
		if ($W == $fp) {
		    $W->bind ($_, \&options)   for @{$Option{keys_options}};
		    }

		# Start Slideshow
		$W->bind ($_, sub {
		    $sls = $def_sls;
		    $aid = $iv->after ($sls, $_next_pic);
		    }) for @{$Option{keys_slideshow}};

		$W->bind ($_, sub {
		    $sls and return;	# No exif during slide show
		    @tn && $ti >= 0 && $ti <= $#tn or return;
		    show_exif ($pr->{exif});
		    }) for @{$Option{keys_exif}};

		$W->bind ($_, sub {
#		    $iv->overrideredirect ($Option{decoration});
#		    $iv->update;
		    $Option{decoration} ^= 1;
		    }) for @{$Option{keys_decoration}};
		}

#	    unless ($Option{decoration}) {
#		$_->overrideredirect (1) for $iv, $iv->parent;
#		}

	    if ($trg eq "show") {
		$trg = "";
		$sls == $def_sls and return; # Already running
		print STDERR "Let the show begin! ...\n";
		$sls = $def_sls;
		return $_pic->($ti);
		}
	    };

	if ($opt_s) {
	    $opt_s = 0;
	    $f11->($Option{slidefull}, $ti, "show");
	    }

	my $ci = $#tn;
	# Bind actions for this thumb
	$w->Tk::bind ("<1>", sub {
	    $ti = $ci;
	    $f11->($vs);
	    }); # Show pic for thumb
	# Attach the info
	my $bmsg =
	    "$pf - $ps bytes\n".
	    "O ($x x $y), F ($fX x $fY)";
	$tb->attach ($w,
	    -balloonposition => "mouse",
	    -postcommand     => sub {
		my $self = shift;
		join ",", $self->rootx - 20, $self->rooty - 60;
		},
	    -balloonmsg      => $bmsg,
	    -msg => {
		Background   => $bmsg,
		tick         => $bmsg,
		});

	# Show pic if on command line
	if ($pic and $img eq $pic) {
	    undef $pic;
	    $ti = $ci;
	    $f11->($vs);
	    }

	# Display the thumbnail
	$w->update;
	}
    $refreshing = "";
    }; # dtcmd

# Still need to find out how to (optionally) hide everything that
# leads to $dir, making $dir to appear as tree root
my $df = $mw->Frame ()->pack (-side => "left", @dpo);
$dt = $df->Scrolled ("DirTree",
    -scrollbars => "osoe",

    -width      => 18,

    -directory	=> $dir,
    -browsecmd  => sub {
	$dt->xview (moveto => .60);
	dtcmd (@_);
	},

    # Tk::Hlist options
    -drawbranch => 1,
    )->pack (-side => "top", @dpo);
$dt->Subwidget ("${_}scrollbar")->configure (-width => 6) for qw( x y );
$dt = $dt->Subwidget ("scrolled");
bind_wheel ($dt, $dt, 10);
# I want <Left> to close a folder expand, and <Right> to expand it
# I also want the focus to follow keyboard actions
$dt->autosetmode;
sub dirup
{
    (my $up = $idir) =~ s:/[^/]+$:: or return;
   #print STDERR Dumper ($dt);
   #$dt->setmode ($idir, "open");
    $dt->close ($idir);
    $dt->setmode ($idir, "close");
    $dt->close ($idir);

    $dt->chdir ($up);
    $dt->open  ($up);
    $dt->setmode ($up, "open");
    $dt->open  ($up);
    $dt->xview (moveto => .60);
    dtcmd ($up);
    } # dirup
$dt->bind ("<Left>", \&dirup);
$dt->bind ($_, sub {
    (my $up = $idir) =~ s:/[^/]+$:: or return;
    $dt->open  ($up);
    $dt->setmode ($up, "open");
    $dt->open  ($up);
    $dt->chdir ($idir);
    $dt->open  ($idir);
    $dt->setmode ($idir, "open");
    $dt->chdir ($idir);
    $dt->open  ($idir);
    $dt->xview (moveto => .60);
    dtcmd ($idir);
    }) for qw( <Right> );

my @fs  = (-font => $f_small);
my @fsv = (@fs, -foreground => "Maroon");
my @fst = (@fs, -foreground => "Navy");
$df->Label (-textvariable => \$ti, @fsv)->pack (-side => "left");
$df->Label (-text         => "#",  @fst)->pack (-side => "left");
$df->Label (-textvariable => \$ni, @fsv)->pack (-side => "left");
$df->Label (-text         => "T",  @fst)->pack (-side => "left");
$df->Label (-textvariable => \$tr, @fsv)->pack (-side => "left");
$df->Label (-text         => "O",  @fst)->pack (-side => "left");
$df->Label (-textvariable => \$or, @fsv)->pack (-side => "left");
$df->Label (-text         => "F",  @fst)->pack (-side => "left");
$df->Label (-textvariable => \$fr, @fsv)->pack (-side => "left");
$df->Label (-text         => "¤",  @fst)->pack (-side => "left");
$df->Label (-textvariable => \$zs, @fsv)->pack (-side => "left");
$df->Label (-text         => "*",  @fst)->pack (-side => "left");
$df->Label (-textvariable => \$Option{decoration},
                                   @fsv)->pack (-side => "left");

$tn = $mw->Scrolled ("Frame",
    -width      => $tnx * $tpx + 45,
    -height     => .65 * $cy,

    -scrollbars => "osoe")->pack (-anchor => "nw", -side => "right", @dpo);
$tn->Subwidget ("${_}scrollbar")->configure (-width => 6) for qw( x y );
$tg = $tn->Subwidget ("scrolled");
bind_wheel ($mw, $tn, 10);
$tg->gridRowconfigure    (0, -weight => 1); # allow expansion in both ...
$tg->gridColumnconfigure (0, -weight => 1); # ... X and Y dimensions

$mw->geometry (loc ($tp, 200 + $tnx * $tpx + 45, .65 * $cy));

foreach my $W ($df, $dt, $tn, $tg, $mw) {	# not $mw, would cause double starts
    $W->bind ($_ => \&exit) for @{$Option{keys_quit}};
    # First pic
    $W->bind ($_, sub {
	$f11 or return;
	$ti = 0;
	$f11->($vs);
	}) for @{$Option{keys_firstpic}};
    # Start Slideshow
    $W->bind ($_, sub {
	$f11 or return;
	$ti < 0 and $ti = 0;
	$f11->($Option{slidefull}, $ti, "show");
	}) for @{$Option{keys_slideshow}};
    }
$mw->bind ($_, \&options) for @{$Option{keys_options}};

dtcmd ($dir);

#$dt->focusForce;

MainLoop;

__END__
0.020  28 Nov 2004  From backpan :)
0.021  08 Dec 2004  Added usage (), command line options (for now only -f),
		    useful locations for .ivrc, $ENV{IVRC}, rotate right now
		    rotates right instead of left, 
0.025  15 Aug 2005  option slidefull & imagefull, Image::ExifTool, take space
		    for toolbar and window decoration into account with size
		    calculations, better resize and rotate, show_exif, better
		    image list, use Image::Info if available, otherwise use
		    identify, rotated thumbnails, reset some vars for slide
		    show, pass name of first pic on command line
0.031  10 Dec 2005  show options, default-keys, more TODO, $opt_v, Image::Info,
		    background/backdrop, slide-show options, first stab at
		    animated pics, key F stores fullscreen on current dir,
0.032  06 Feb 2006  Show legal values for alt options in usage
0.033  16 Feb 2006  Skip un-identify-able pics, up- and down keys in treeview
0.034  02 Jan 2007  Rotation saves Orientation *and* Rotation
0.035  11 Feb 2007  Added fit-to-height (h), fit-to-width (b) and orig-size (o)
		    Added changelog, delete folder if empty, fix key-F
0.036  22 Jun 2007  Added key bindings to set image position
0.037  26 Jun 2007  Support for Image::Size; better parsing for identify
0.038  18 Aug 2007  Reverse is alias fro descending for ThumbSortOrder
0.039  30 Aug 2007  Added random sorting for images
0.040  03 Sep 2007  Cleaned up slideshow somewhat. added -s
0.041  09 Sep 2007  Some perl::critic cleanups
0.042  10 Sep 2007  Prevent update while update
0.043  17 Sep 2007  Reset update status if folder deleted
		    Remember the refreshed folder in refreshing
0.044  25 Sep 2007  Upgrade window titles to UTF-8
0.045  05 Oct 2007  Some perlcritic cleanups (perlcritic also evolves)