#!/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.032;

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,
    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_full_rc	=> [qw( Shift-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			)],
    );

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)",
		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
#	* 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 ?

# 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
GetOptions (
    "v:1" => \$opt_v,
    "f"   => \$opt_f,
    ) 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 Time::HiRes qw( gettimeofday tv_interval );
use Data::Dumper; $Data::Dumper::Sortkeys = 1;
use File::Copy;

our $exiftool = 0;
our $iinftool = 0;
our $exiftran = 0;
eval {
    use Image::ExifTool qw( ImageInfo );
    $exiftool = Image::ExifTool->new ();
    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 )],
	 [ "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 $b = $ow->BrowseEntry (
		-width              => 12,
		-borderwidth        =>  1,
		-highlightthickness =>  1,
		-listwidth          => 40,
		-variable           => $var,
		-browsecmd          => $cmd,
		)->grid (-row => $row, -column => 1, -sticky => "news");
	    $b->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] },

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

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

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

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;

    # 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/}{:};
    $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 $_ ] }
	      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/ 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 $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/'/ ? '"' : "'";
	    chomp (my @id = `identify $q$pf$q`);
	    ($x, $y) = ($id[0] =~ m/\s(\d+)x(\d+)\s/);
	    }
	$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",
	    );

	push @tn, {
	    wdgt => $w,		# Widget
	    angl => $angl,	# rotation angle
	    phys => {		# Physical location and size
		file => $pf,
		dir  => $idir,
		titl => $img,
		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 == 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 == 1 and return;	# No zoom from Full-screen
		$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
		$W->bind ($_, 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->grab;
		    #$mw->focusForce;
		    #$dt->focusForce;
		    }) 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) {
		    sub ExifOrient ($$)
		    {
			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);
			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}};

		# 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;
		    $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 {
			dtcmd ($idir);
			}
		    }) for @{$Option{keys_delete}};

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

		$W->bind ($_, \&options)   for @{$Option{keys_options}};

		$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;
#		}

	    my $act = $trg or return;
	    $trg = "";
	    $act eq "show" and return $_pic->($ti);
	    };

	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;
	}
#my $elapsed = tv_interval ($t0);
#print STDERR "$elapsed\n";
    }; # 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;
$dt->bind ("<Left>", sub {
    (my $up = $idir) =~ s:/[^/]+$:: or return;
    $dt->chdir ($up);
   #$dt->close ($up);
    $dt->xview (moveto => .60);
    dtcmd ($up);
    });
$dt->bind ($_, sub {
    $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;
	$sls = $def_sls;
	$f11->($Option{slidefull}, $ti, "show");
	}) for @{$Option{keys_slideshow}};
    }
$mw->bind ($_, \&options) for @{$Option{keys_options}};

dtcmd ($dir);
#$dt->focusForce;

MainLoop;