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

# TODO: * save/load from .ivrc buttons on option window
#	* Slideshow behaviour: location, dir depth, cycling
#	  randomness, slide lists
#	* Slideshow play list
#	* Image manipulation
#	  - Crop
#	  - Save, save as
#	* Titles and decoration behaviour
#	* Hide dirs above dt root
#	* Menu's ?
#	* Bind scrollwheel to scrollbar for Thumb Grid

# Filter out the irfanview options that I don't support
@ARGV = grep { !m{^/(hide|thumbs?)(=\d+)?$} } @ARGV;

use Getopt::Long qw(:config bundling nopermute passthrough);

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 X11::Protocol;
use Time::HiRes qw( gettimeofday tv_interval );

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

    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_rotleft	=> [qw( Key-l			)],
    keys_rotright	=> [qw( Key-r			)],
    keys_zoomin		=> [qw( plus			)],
    keys_zoomout	=> [qw( minus			)],
    keys_delete		=> [qw( Delete			)],
    keys_slideshow	=> [qw( Key-w Key-s		)],
    );
{   my @opt;
    if (open my $of, "< $ENV{HOME}/.ivrc") {
	while (<$of>) {
	    m/^[#!]/		and next;
	    s/\s+$//;
	    m/^\S+\s*=\s*\S/	or  next;
	    push @opt, $_;
	    }
	close $of;
	}
    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}};
    }

my $dir = @ARGV && -d $ARGV[0] ? shift @ARGV : $Option{imagedir};
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};

# 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) = (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);
    my $rot = $r ? "-rotate $r " : "";
    my $cfn = "/tmp/iv$$-".$pxyid++.".jpg";
    system "convert -size ${x}x${y} -resize ${x}x${y}+0+0 $rot '$f' $cfn";
    $p = $w->Photo (-file => -f "$cfn.0" ? "$cfn.0" : $cfn);
    unlink <${cfn}*>;	# convert generates multiple files for animated images
    $p;
    } # PhotoXY

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 ],
	 ) {
	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 = (
    # 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;
    for (@tn) {
	$_ && ref $_ && $_->{wdgt} && Exists ($_->{wdgt}) and
	    $_->{wdgt}->destroy ();
	}
    # New dir, reset globals
    ($tr, $or, $fr, $ti, $vs, $sls, $zs, @tn) = (0, 0, 0, -1, 0, 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  { m/(\d+)/; [ $_, $1 // 0, (stat$_)[7,9], lc $_ ] }
	      # convert can't deal with .ico files (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;
    foreach my $img (@img) {
	my $nt = @tn;

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

	# Read it
	my $o;
	my ($x, $y) = (`identify '$pf'` =~ 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 $tf = $tpx / ($y > $x ? $y : $x);
	my ($tX, $tY) = map { int } ($tf * $x, $tf * $y);

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

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

	push @tn, {
	    wdgt => $w,		# Widget
	    angl => 0,		# 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,
		},
	    };

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

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

	    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}) {
		    $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;

	    $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;
	    #$iv->focusForce;

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

	    $_next_pic = sub {
		$_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) {
		# Toggle Full-Screen
		$W->bind ($_, $f11) for @{$Option{keys_fullscreen}};

		# 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;
		    Exists ($fp) and $fp->destroy;
		    Exists ($pw) and $pw->destroy;
		    Exists ($iv) and $iv->destroy;
		    #$mw->grab;
		    #$mw->focusForce;
		    #$dt->focusForce;
		    }) for @{$Option{keys_quit}};

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

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

		# 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;
		    $iv->after ($sls, $_next_pic);
		    }) for @{$Option{keys_slideshow}};

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

	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,
		});

	# 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");

$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 );
bind_wheel ($tn, $tn, 10);
$tg = $tn->Subwidget ("scrolled");
bind_wheel ($tg, $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) {
    $W->bind ($_ => \&exit) for @{$Option{keys_quit}};
    # First pic
    $W->bind ($_, sub {
	$ti = 0;
	$f11->($vs);
	}) for @{$Option{keys_firstpic}};
    $W->bind ($_, \&options) for @{$Option{keys_options}};
    }

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

MainLoop;