#!/usr/bin/perl

# picasagallery by twitham@sbcglobal.net, 2013-12

# remote-control (keyboard) driven mythgallery-style picture browser
# that also understands local Picasa data: albums, faces, stars,
# uploads, captions, exif, tags, and so on.

# TODO: support all Picasa file formats (videos for example) (help ->
#	options -> file types: jpe?g, bmp, gif, png, tga, tiff?, webp,
#	psd, (many raw), (movies: avi, mpg, asf, wmv)
# TODO: directory/file sort options: name, date, reverse
# TODO: config file should be able to auto-start a {slideshow} = /root/path
# TODO: speed up thumbnail rebuild option (don't reload whole directory)
# TODO: documentation?

# to extract thumbnails from videos (1 frame @ 60 seconds):
# ffmpeg -ss 60 -vframes 1 -i $video [-s 640x480] $file.jpg

# to play videos:
# mplayer -fs -vf yadif -sub-paths srt $video

use strict;
use warnings;
use Tk;
use Tk::Dialog;
use Tk::Frame;
use Tk::JPEG;
use Tk::PNG;
use Tk::Bitmap;
use Tk::Pixmap;
use Tk::Photo;
use Tk::Font;
use Tk::ErrorDialog;   # unexpected errors to dialog instead of stderr
use Tk::Table;			 # for picture browser
use Tk::ProgressBar;		 # for metadata refreshing progress bar
use Storable qw(nstore retrieve); # for saving metadata cache
use Data::Dumper;		 # for saving metadata cache in readable format
use File::Path;			 # for creating thumbnail paths
use Time::Local;		 # for age calculations
use Image::ExifTool qw(:Public); # for picture metadata
use Image::Magick;		 # for picture conversions
use Picasa;			 # for groking Picasa data!

# config file can override any settings here (Picasa.pm also uses a few):
our $conf = {
    config	=> './.picasagallery_conf.pl', # config to require, if present
    metadata	=> '.picasagallery.cache',   # cache of picture data
    metaperl	=> 0,	 # filename for cache in perl format, 0 = none
    cache	=> '.thumbcache', # where to put thumbnails
    keep	=> '(?i)\.(jpe?g|gif|x[pb]m|png|bmp|tiff?|nef)$',
    reject	=> '(?i)\b(\.?thumb(nail)?s?(.db)?)\b',
    datefmt	=> '%Y-%m-%d %H:%M:%S %a', # must be sortable w/year first
    update	=> \&update,	# don't change this (GUI updates)
    debug	=> 0,		# debug to STDERR?
    info	=> 0,		# overlay metadata on images?
    width	=> 1920, # initial size also determines thumbnail size
    height	=> 1080,
    fullscreen	=> 0, # go full-screen with no borders (ignore width/height)
    birthday	=> {}, # optional contact(id|name) => 'yyyy/mm/dd' birthdays
    bg		=> 'black',	# background color for the application
    dbg		=> 'gray33',	# background color for directory tiles
    select	=> 'green',	# current thumbnail selection color
    text	=> 'white',	# corner information text color
    title	=> 'red',	# header/footer color
    face	=> 'green',  # face box color (uncommon picture color)
    ssc		=> 'green',  # slide show color
    scroll	=> 'magenta',	# pan mode scroll bar color
    filtering	=> 0,		# how many filters are in effect
    filters	=> [qw/Stars Uploads Faces Albums Captions Tags/],
    filter	=> {
	age => 0,	   # show only newer than X seconds before now
    },
    slideshow	=> '',		# root of current automatic slide show
    delay	=> 4,		# seconds to show each picture
    random	=> 0,		# 0 = sequential, 1 == random show
    pan		=> 0, # 0 = full picture, 1 = 1D pan, 2 == 2D pan (100%)
    thumbcrops	=> 0,		# 1 = zoom (crop) thumbnails to fill tiles
    facecrops	=> 1,		# 1 = face thumnails in [People] paths
    fast	=> 0,		# 0 = scan for changes, 1 = use cache only
    overlay	=> 0,		# 0 = replace, 1 = overlay pictures
    attrs	=> 0,		# prate attribute hash {file}{n,a}
    variable	=> 1,		# variable speed show (if n ratings in attrs)
};

# configuration file can override any of the above options:
require $conf->{config} if -f $conf->{config};

# command line can override config file and above defaults:
map { /^(\w+)=(.*)$/ and $conf->{$1} = $2 } @ARGV;
-f $conf->{metadata} or $conf->{fast} = 0;

#  rebuild all data since prior run, using previous cache until finished
my $picasa = Picasa->new($conf);

my @ss;			   # slide show picture list
my $ssindex = 0;	   # slide show index
my $refreshing = '';	   # directory currently refreshing thumbnails
my %rebuildthumb;	   # stale thumbnails to rebuild

# don't accidentally recurse: create thumbnail cache only with confirmation
unless (-d $conf->{cache}) {
    -t STDIN or die "bailing out, $conf->{cache} not configured here!\n";
    print "$conf->{cache} doesn't exist here!
Shall I create it and recurse for pictures?  yes/no [no] : ";
    my $ans = <>;
    $ans =~ /^\s*y/
	or die "cd to root of pictures or configure $conf->{config}
\(see \$conf in $0\)\n";
    mkdir $conf->{cache} or die "can't mkdir $conf->{cache}: $!\n";
}

my $exif = new Image::ExifTool;	# for collecting picture metadata
$exif->Options(FastScan => 1, DateFormat => $conf->{datefmt});

# main window is a thumbnail browser ----------------------------------------
my $mw = Tk::MainWindow->new (-title => "Picasa Gallery", -bg => $conf->{bg});
my $cur = $mw;			# current window
my($mx, $my) = ($conf->{width}, $conf->{height});
$mw->geometry(sprintf "%dx%d", $mx, $my);
$mw->update;
$conf->{fullscreen} and &togglefullscreen($mw);

my $pos;			    # position indicator timer
my $ss = $mw->repeat(1000, \&show); # slideshow timer
$ss->time(0);			    # but not yet running

my $tnx = 7;		       # columns of thumbnails to display
my $tpx = int(($mx - 4 * $tnx - 50) / $tnx); # 50 = scroll + progress bar width
my $tpy = int($tpx / 1.1);	# "average" aspect ratio for most pics

my %s;				# strings - data on labels
my %l;				# label widgets - top and bottom of browser
my %m;				# menu widgets

# maybe font should be replaced on <configure> window resize...
my $font = $mw->Font(-family => 'Helvetica',
		    -size => int($my / 50), # 15,
    );

my @c = (-fg => $conf->{text}, -bg => $conf->{bg});
my $top = $mw->Frame(@c)->pack(qw/-side top -fill x/);
$l{nw} = $top->Label(-textvariable => \$s{nw}, -font => $font, @c)
    ->pack(-side => "left");
$l{ne} = $top->Label(-textvariable => \$s{ne}, -font => $font, @c)
    ->pack(-side => "right");
$l{n} = $top->Label(-textvariable => \$s{n},  -font => $font, @c,
		    -fg => $conf->{title})->pack(qw/-side top/);

my $bot = $mw->Frame(@c)->pack(qw/-side bottom -fill x/);
$l{sw} = $bot->Label(-textvariable => \$s{sw}, -font => $font, @c)
    ->pack(-side => "left");
$l{se} = $bot->Label(-textvariable => \$s{se}, -font => $font, @c)
    ->pack(-side => "right");
$l{s} = $bot->Label(-textvariable => \$s{s}, -font => $font, @c,
		    -fg => $conf->{title})->pack(qw/-side bottom/);

# thumbnail table grid
my $tg = $mw->Table(qw/-rows 4 -columns 7 -scrollbars w -bg/ => $conf->{bg},
    )->pack(qw/-side left -expand 1 -fill both/);

# metadata refreshing progress bar
my $sofar = 0;
my $pg = $mw->ProgressBar(qw/-anchor s -gap 0 -troughcolor red -to/ =>
			  $picasa->{pics} ? scalar keys %{$picasa->{pics}}
			  : 1000, -variable => \$sofar,
    )->pack(qw/-side right -expand 0 -fill y/);

# full size image viewer --------------------------------------------------
my $full = $mw->Toplevel(-width => $mx, -height => $my, -bg => $conf->{bg});
$full->geometry(sprintf "%dx%d", $mx, $my);
$full->update;
$conf->{fullscreen} and &togglefullscreen($full);
my $scale = 1;			# scale of current picture
my $canvas = $full->Canvas(qw/-highlightthickness 0 -borderwidth 0 -bg/
			   => $conf->{bg})
    ->pack(qw/-side top -anchor nw -expand 1 -fill both/);
my $image = $mw->Photo;
$image->blank;
$canvas->createImage(qw/0 0 -anchor nw -tags image -image/ => $image);

# popup option menu is invoked with "m" key ----------------------------------
$m{m} = $mw->Menu(qw/-tearoff 0 -takefocus 1 -font/ => $font);
$m{m}->transient($mw);		# not needed?
$m{m}->add('command', -label => 'Menu: Picasa Gallery',
	   qw(-accelerator m -underline 0)); #, -state => 'disabled');
$m{m}->add(qw/command -label Help -accelerator h -underline 0 -command/
	   => \&help);
$m{m}->add('command', -label => 'Information Overlay',
	   qw(-accelerator i -underline 0 -command) => \&info);
$m{m}->add(qw/command -accelerator F11 -label/ => 'Full Screen',
	   -command => sub { &togglefullscreen($cur) });
$m{m}->add('checkbutton', -label => 'Overlay Pictures',
	   qw(-underline 0 -variable) => \$conf->{overlay});
$m{m}->add('checkbutton', -label => 'Zoom Thumbnails',
	   qw(-accelerator e -underline 0 -variable) => \$conf->{thumbcrops},
	   -command => \&refilter);
$m{m}->add('checkbutton', -label => 'Face Thumbnails',
 	   qw(-underline 5 -variable) => \$conf->{facecrops},
	   -command => \&refilter);
$m{m}->add('separator');
my $i = 0;
$m{m}->add('command', -label => "Clear All Filters",
	   -accelerator => $i++, -underline => 0, -command =>
	   sub { $mw->eventGenerate('<Key-0>') });
$m{filter} = $m{m}->Menu(qw/-tearoff 0 -font/ => $font);
for (@{$conf->{filters}}) {
    $m{filter}->add(qw/checkbutton -onvalue 1 -offvalue 0 -underline 0/,
		    -label => $_,
		    -accelerator => $i++,
		    -variable => \$conf->{filter}{$_},
		    -command => \&refilter);
}
$m{m}->add(qw/cascade -underline 0 -label/ => 'Filter by Attributes',
	   -menu => $m{filter});
$m{age} = $m{m}->Menu(qw/-tearoff 0 -font/ => $font);
my $day = 24 * 60 * 60;
my $year = 365.25 * $day;	# approximate, close enough
my %age = my @age		# ugly menu, but any better way?
    = (			 # maybe a slider widget, but where to put it?
    'unlimited'	=> 0,
    '20 years'	=> 20 * $year,
    '15 years'	=> 15 * $year,
    '10 years'	=> 10 * $year,
    '7 years'	=> 7 * $year,
    '5 years'	=> 5 * $year,
    '3 years'	=> 3 * $year,
    '2 years'	=> 2 * $year,
    '1 year'	=> 1 * $year,
    '9 months'	=> 9 / 12 * $year,
    '7 months'	=> 7 / 12 * $year,
    '5 months'	=> 5 / 12 * $year,
    '3 months'	=> 3 / 12 * $year,
    '2 months'	=> 2 / 12 * $year,
    '7 weeks'	=> 7 * 7 * $day,
    '5 weeks'	=> 5 * 7 * $day,
    '3 weeks'	=> 3 * 7 * $day,
    '2 weeks'	=> 2 * 7 * $day,
    '7 days'	=> 7 * $day,
    '5 days'	=> 5 * $day,
    '3 days'	=> 3 * $day,
    '2 days'	=> 2 * $day,
    );
{
    my $last;
    for (@age) {
	$age{$_} = $last and next if /^\d+$/;
	$m{age}->add('radiobutton',
		     -label => $_,
		     -variable => \$conf->{filter}{age},
		     -value => $age{$_},
		     (/^\d year|unlimited/ ? (-underline => 0) : ()),
		     -command => \&refilter);
	$last = $_;
    }
}
$m{m}->add('cascade', -label => 'Filter by Age',
	   -menu => $m{age}, -underline => 10);
$m{m}->add('separator');

$m{ss} = $m{m}->Menu(qw/-tearoff 0 -font/ => $font);
$m{ss}->add('command', -label => 'Play / Pause',
	    qw(-accelerator p -underline 0 -command) => sub {
		$mw->eventGenerate('<Key-p>'); });
$m{ss}->add('command', -label => 'Stop / Reset',
	    qw(-accelerator t -underline 0 -command) => sub {
		$mw->eventGenerate('<Key-t>'); });
$m{ss}->add(qw(checkbutton -label Random -underline 0 -accelerator r),
	    -variable => \$conf->{random}, -command => \&refilter);
$m{ss}->add(qw(checkbutton -underline 0 -label) => 'Variable Speed',
	    -variable => \$conf->{variable})
    if $conf->{attrs};
$m{delay} = $m{ss}->Menu(qw/-tearoff 0 -font/ => $font);
for (1 .. 20) {
    $m{delay}->add('radiobutton',
		   -label => "$_ seconds",
		   -variable => \$conf->{delay},
		   -value => $_,
		   ($_ < 10 ? (-underline => 0) : ()),
		   -command => \&showgo);
}
$m{ss}->add('cascade', -label => 'Delay',
	     -menu => $m{delay}, -underline => 0);
$m{m}->add('cascade', -label => 'Slide Show',
	   -menu => $m{ss}, -underline => 0);
$m{m}->add('command', -label => 'Rebuild Thumbnail',
	   -underline => 0, -command =>
	   sub { 	
	       my $tmp = "$picasa->{file}{dir}$picasa->{file}{file}";
	       $tmp =~ s@/$@@;
	       $rebuildthumb{$tmp} =
		   $rebuildthumb{$picasa->{file}{physical}} = 1;
	       &newdir;
	   });
$m{m}->add('command', -label => 'Quit', -underline => 0, -command =>
	   sub { while(1) { $mw->eventGenerate('<Escape>'); } });

$m{m}->bind('<Unmap>', sub { $m{m}->withdraw; $cur->raiseFocus; });

$mw->raiseFocus;

# 3x3 touch/click help overlay ----------------------------------------
my @key = qw(
	<Escape>	<Up>		<Key-i>
	<Left>		<Return>	<Right>
	<Key-m>		<Down>		<Key-m>);
my @desc =
    ('<-- back to PARENT', "PREVIOUS row/\nscroll UP", 'INFORMATION',
     "PREVIOUS pic/\nscroll LEFT", 'ZOOM in/out', "NEXT pic/\nscroll RIGHT",
     "MENU/\nshow more keys","NEXT row/\nscroll DOWN","MENU/\nshow more keys");

sub help {
    my %opt = (qw/-fill yellow -tags help/);
    $s{nw} = '<-- <Escape> to parent';
    $s{n} = 'Scroll <Up>';
    $s{ne} = 'Information <Key-i>';
    $s{sw} = $s{se} = 'MENU <Key-m>';
    $s{s} = 'Scroll <Down>';
    $l{$_}->configure(-fg => $opt{'-fill'}, -bg => $conf->{bg})
	for qw/nw n ne se s sw/;
    for my $i (0 .. 8) {	# global @key defined above
	my $x = $mx / 3 * int($i % 3) + $mx / 6;
	my $y = $my / 3 * int($i / 3) + $my / 6;
#	$canvas->createTextBox($x, $y, 'black',
	$canvas->createText($x, $y, -font => $font,
			    qw/-justify center -anchor center -text/
			    => "$desc[$i]\n$key[$i]", %opt);
	$canvas->createLine($x + $mx / 6, 0, $x + $mx / 6, $my, %opt);
	$canvas->createLine(0, $y + $my / 6, $mx, $y + $my / 6, %opt);
    }
}

# all event bindings happen here ----------------------------------------

$full->bind('<Button-1>' => [sub { # 3x3 "touch" control zones
    my($w, $x, $y) = @_;
    my $hitkey = int($x / $mx * 3) + 3 * int($y / $my * 3);
    $key[$hitkey] and $full->eventGenerate($key[$hitkey]);
			     }, Ev('x'), Ev('y')]);
# similar "touch" control zones for main window via text labels
$l{nw}->bind('<Button-1>' => [sub { $mw->eventGenerate($key[0]) }]);
$l{n}->bind('<Button-1>' => [sub { $mw->eventGenerate($key[1]) }]);
$l{ne}->bind('<Button-1>' => [sub { $mw->eventGenerate($key[2]) }]);
$l{sw}->bind('<Button-1>' => [sub { $mw->eventGenerate($key[6]) }]);
$l{s}->bind('<Button-1>' => [sub { $mw->eventGenerate($key[7]) }]);
$l{se}->bind('<Button-1>' => [sub { $mw->eventGenerate($key[8]) }]);

$mw->bind('<Configure>' =>	# maybe reposition thumbs
	  sub  { my $w = shift;
		 return unless $w =~ /Table/;
		 return if $refreshing;
		 my($x, $y) = ($w->width, $w->height);
		 my $newx = int(($x - 20) / ($tpx + 4));
		 $newx > 0 or $newx = 1;
#		 warn ">>>$w\t$x x $y\t$newx\n";
		 if ($newx != $tnx) {
		     $tnx = $newx;
		     &newdir;
		 }
	  });
$full->bind('<Configure>' => # resize window resizes full-size picture
	    sub  { my $w = shift;
		   $mx != $w->width or $my != $w->height or return;
		   ($mx, $my) = ($w->width, $w->height);
		   &newpic;
	    });

$mw->bind('<Button-1>' => [\&click, Ev('W')]);
$mw->bind('<MouseWheel>' => [sub { # scroll window up/down
    my($w, $d) = @_;
    $mw->eventGenerate($d < 0 ? '<Down>' : '<Up>');
			     }, Ev('D')]);

for my $w ($mw, $full) {	# both windows have same key bindings

    $w->bind('<KeyPress>', [\&processkey, Ev('A'), Ev('k'), Ev('K'), Ev('N')]);

    for (qw(<F11>)) {
	$w->bind($_, sub {	# toggle full screen display
	    &togglefullscreen($w);
		 });
    }
    for (qw(<Key-m> <Button-3>)) {
	$w->bind($_, sub {	# popup options menu
	    $m{m}->Post($w->x + $w->width / 3, $w->y + $w->height / 3);
	    $m{m}->raiseFocus	# -takefocus fails on ubuntu???
		unless $^O =~ /MSWin/;
		 });
    }
    for (qw(<Escape> <BackSpace> <Key-q> <Button-2>)) {
	$w->bind($_, sub {	# up or exit
	    my $tmp = $mw->focusCurrent;
	    if ($mw->focusCurrent eq $full) {
		$mw->raiseFocus;
		&move;
	    } elsif ($picasa->{dir}{file} eq '/') { # exit app
		$full->destroy;
		$mw->destroy;
		Tk::exit;
		exit;
	    } else {
		$picasa->up;
		&newdir;
	    }
		 });
    }
    for (qw(<Return>)) {
	$w->bind($_, sub {	# enter subdirectory or full picture
	    if ($mw->focusCurrent eq $full) { # pan/zoom cycle
		$conf->{pan}++; $conf->{pan} = 0 if $conf->{pan} > 2;
		&newpic;			 # reload at new size
		$conf->{pan} and &picmove(0, 0); # add scroll indicators
	    } elsif ($picasa->down) {
		$mw->raiseFocus;
		&newdir;
	    } else {
		$full->raiseFocus;
		&newpic;
	    }
		 });
    }
    for (qw(<Right> <space>)) {
	$w->bind($_, sub {	# next picture or subdir
	    if ($conf->{pan} and $mw->focusCurrent eq $full) {
		&picmove($mx / -10, 0);
	    } else {
		$picasa->next;
		&newpic;
	    }
		 });
    }
    for (qw(<Left>)) {
	$w->bind($_, sub {	# previous picture or subdir
	    if ($conf->{pan} and $mw->focusCurrent eq $full) {
		&picmove($mx / 10, 0);
	    } else {
		$picasa->prev;
		&newpic;
	    }
		 });
    }
    for (qw(<Down>)) {
	$w->bind($_, sub {	# next row
	    if ($conf->{pan} and $mw->focusCurrent eq $full) {
		&picmove(0, $my / -10);
	    } else {
		$picasa->next($tnx);
		&newpic;
	    }
		 });
    }
    for (qw(<Up>)) {
	$w->bind($_, sub {	# previous row
	    if ($conf->{pan} and $mw->focusCurrent eq $full) {
		&picmove(0, $my / 10);
	    } else {
		$picasa->prev($tnx);
		&newpic;
	    }
		 });
    }
    for (qw(<Next>)) {
	$w->bind($_, sub {	# next page
	    $picasa->next($tnx * 4);
	    &newpic;
		 });
    }
    for (qw(<Prior>)) {
	$w->bind($_, sub {	# previous page
	    $picasa->prev($tnx * 4);
	    &newpic;
		 });
    }
    for (qw(<Key-F> <Key-f>)) {
	$w->bind($_, sub {	# faster slideshow
	    $conf->{delay}--;
	    $conf->{delay} >= 1 or $conf->{delay} = 0.5;
	    &showgo;
		 });
    }
    for (qw(<Key-B> <Key-b>)) {
	$w->bind($_, sub {	# slower slideshow
	    $conf->{delay} >= 1 or $conf->{delay} = 0;
	    $conf->{delay}++;
	    $conf->{delay} <= 20 or $conf->{delay} = 20;
	    &showgo;
		 });
    }
    for (qw(<Key-r>)) {
	$w->bind($_, sub {	# random toggle
	    $conf->{random} = $conf->{random} ? 0 : 1;
	    &refilter;
	    &showgo;
		 });
    }
    for (qw(<KeyRelease>)) {
	$w->bind($_, [sub {	# pause slide show
	    my($w, $ascii) = @_;
	    return if $ascii =~ /[pfbr]/i;
	    $conf->{slideshow} and # show in progress
		$ss->time or return;
	    $ss->time(0);
	    &move;		# update info
	    &newpic;
	    $conf->{random} and &newdir;
		      }, Ev('A')]);
    }
    for (qw(<Key-p>)) {
	$w->bind($_, sub {	# start / pause /resume slide show
	    if ($conf->{slideshow}) { # show in progress
		if ($ss->time) {      # running -> pause
		    $ss->time(0);
		    &move;	# update info
		    &newpic;
		    $conf->{random} and &newdir;
		} else {	# paused -> run
		    &showgo;
		}
	    } else {	   # no show -> start one at current selection
		my $now = "$picasa->{file}{dir}$picasa->{file}{file}";
		$now =~ m@/$@ or
		    $now = "$picasa->{dir}{dir}$picasa->{dir}{file}";
		$conf->{slideshow} = $now;
		&refilter;
		&showgo;
	    }
		 });
    }
    for (qw(<Key-t>)) {
	$w->bind($_, sub {	# stop slide show
	    $ss->time(0);
	    $conf->{slideshow} = '';
	    @ss = ();
	    $ssindex = 0;
	    &newpic;
	    &move;
		 });
    }
    for (qw(<Key-i>)) {
	$w->bind($_, sub {	# information toggle
	    &info
		 });
    }
    for (qw(<Key-e>)) {
	$w->bind($_, sub {	# thumbnail size
	    $conf->{thumbcrops} = $conf->{thumbcrops} ? 0 : 1;
	    &refilter;
		 });
    }
    for (qw(<Key-h> <F1>)) {
	$w->bind($_, \&help);	# help toggle
    }
}

# all metadata is updated in the background at each startup ----------------
warn "starting Picasa recursion\n" if $conf->{debug};
$mw->after(1500, sub {		# show browser after we have some data
    $mw->eventGenerate('<Return>');
    $tg->eventGenerate('<Configure>'); });
$conf->{tweakdata} and &{$conf->{tweakdata}}($picasa);
if ($conf->{fast}) {		# shortcut - use cached data only
    $picasa->{done} = 1;
} else {		     # search for changes, write out new cache
    $picasa = $picasa->recursedirs('.'); # updates GUI via $conf->{update}
    if ($picasa->{done}) {		 # save current updated cache
	if ($conf->{metadata}) {	 # nstored cache
	    warn "saving $conf->{metadata}...\n" if $conf->{debug};
	    my $tmp = "$conf->{metadata}~";
	    nstore $picasa, $tmp or warn "can't store $tmp: $!\n";
	    rename $tmp, $conf->{metadata} or warn "can't reanme $tmp: $!\n";
	    warn "$conf->{metadata} saved\n" if $conf->{debug};
	}
	if ($conf->{metaperl}) {
	    my $tmp = "$conf->{metaperl}~";
	    if (open my $fh, '>', $tmp) {
		warn "saving $conf->{metaperl}...\n" if $conf->{debug};
		$Data::Dumper::Indent = 1; # readable format for the cached metadata
		$Data::Dumper::Purity = 1; # output only, {metadata} is the real cache
		print $fh Dumper $picasa or warn $!;
		close $fh and rename "$conf->{metaperl}~",
		$conf->{metaperl} or warn $!;
		warn "$conf->{metaperl} saved\n" if $conf->{debug};
	    } else {
		warn "can't write $tmp: $!\n";
	    }
	}
    }
    $conf->{tweakdata} and &{$conf->{tweakdata}}($picasa);
}

&update(1);			   # update stats one last time
$pg->value($pg->cget('-to') + 10); # empty the progress bar
warn "Picasa recursion done!\n" if $conf->{debug};

MainLoop;			# never returns
Tk::exit;			# should never get here

sub picmove {			# pan picture with view indicators
    my($dx, $dy) = @_;
    $canvas->move('image||faces', $dx, $dy);
    my($x, $y) = $canvas->coords('image');
    my $this = $picasa->{file} or return;
    my $pf = $this->{physical} or return;
    my $data = $picasa->{pics}{$pf} or return; # data of this picture
    my $w = $data->{width} * $scale or return;
    my $h = $data->{height} * $scale or return;
    my $left = 0 - $x;		# pixels off-screen, negative == none
    my $right = $x + $w - $mx;
    my $above = 0 - $y;
    my $below = $y + $h - $my;
    if ($dx and ($left < $mx / -4 or $right < $mx / -4)) { # pan stops
	$dx > 0 and $left < $mx / -4 and $picasa->prev;
	$dx < 0 and $right < $mx / -4 and $picasa->next;
	&newpic;
	return;
    }
    if ($above < $my / -4 or $below < $my / -4) {
	$canvas->move('image||faces', 0, -$dy);
	$above -= $dy; $below -= $dy;
    }
#    warn "picmove: $w x $h @ $x, $y: l=$left, r=$right\n";
    $canvas->delete('view');
    $canvas->createLine($left / $w * $mx, $my - 6,
			$mx - ($right / $w * $mx), $my - 6,
			-fill => $conf->{scroll},
			qw/-width 5 -arrow both -tags view/)
	if $left > 0 or $right > 0;
    $canvas->createLine(6, $above / $h * $my,
			6, $my - ($below / $h * $my),
			-fill => $conf->{scroll},
			qw/-width 5 -arrow both -tags view/)
	if $above > 0 or $below > 0;
    if ($left > 0 or $right > 0
	or $above > 0 or $below > 0) {
	$canvas->raise('view', 'image||bg');
	$conf->{info} and $canvas->raise('fg', 'view');
    }
}

sub click {			# select or enter selection
    my($w) = @_;
    my($r, $c) = $tg->Posn($w);
    return unless $r and $c;
    $picasa->{pindex} = $picasa->{index};
    $picasa->{index} = --$r * $tnx + --$c; # index 1 -> index 0
    $picasa->filtermove;
    &move;
    $picasa->{index} == $picasa->{pindex} and
	$mw->eventGenerate('<Return>');
}

sub showgo {			# start show or adjust time delay
#    warn "showgo: $conf->{slideshow};\n";
    return unless $conf->{slideshow};
    &show;
    $full->raiseFocus;
#    warn $mw->afterInfo($ss);
}

sub show {		# slide show callback: advance to next picture
    $mw->update;
    return unless @ss;
    my $was = "$picasa->{dir}{dir}$picasa->{dir}{file}";
    my $pic = "$picasa->{file}{dir}$picasa->{file}{file}";

    # search for current location since user may have moved it
    while ($ssindex <= $#ss) {	# start at last known location
#    	warn "checking 1 $ssindex: $ss[$ssindex] $pic\n";
    	last if 0 == index($ss[$ssindex], $pic); # found!
	$ssindex++;
    }
    unless ($ss[$ssindex]) {	# look earlier if not yet found
    	$ssindex = 0;
    	while ($ssindex <= $#ss) {
#    	    warn "checking 2 $ssindex: $ss[$ssindex] $pic\n";
    	    last if 0 == index($ss[$ssindex], $pic); # found!
	    $ssindex++;
    	}
    }
    $ssindex > $#ss and # user navigated above slide show; cancel it
	do { $mw->eventGenerate('<Key-t>'); return; };
    $ssindex++ if $ss[$ssindex] eq $pic;
    $ss[$ssindex] or $ssindex = 0;
    $picasa->goto($ss[$ssindex]);
    my $now = "$picasa->{dir}{dir}$picasa->{dir}{file}";
    &newpic;
    $was eq $now or &newdir;
    my $delay = $conf->{delay};
    if ($conf->{attrs} and $conf->{variable} and
	my $this = $conf->{attrs}{$picasa->{file}{physical}}) {
	if (defined $this->{n}) {
	    $delay *= $this->{n} / 9;
	}
    }
    $ss->time(0);
    $ss = $mw->after($delay * 1000, \&show);
}

sub processkey {  # generic key event handler if nothing more specific
    my($win, $ascii, $code, $str, $num) = @_;
#    warn "'$ascii $code $str $num' was pressed\n";
    if ($ascii =~ /^\d+$/) {
	if ($ascii == 0) {	# clear all filters
	    map { $conf->{filter}{$_} = 0 } keys %{$conf->{filter}};
	} elsif (defined $conf->{filters}[--$ascii]) { # toggle filter
	    $conf->{filter}{$conf->{filters}[$ascii]} = 
		! $conf->{filter}{$conf->{filters}[$ascii]};
	}
	&refilter;
    }
}

sub refilter {	       # reapply filters, updating dir, pic, slideshow
    $picasa->filtermove;	# update all metadata
    if ($conf->{slideshow}) {
	@ss = $picasa->filter($conf->{slideshow}, 'slideshow');
	$conf->{random} and
	    @ss = sort { rand(1) < 0.5 ? -1 : 1 } @ss;
    }
    $refreshing = '';
    &newdir;
    &newpic;
}

BEGIN {	# filtering for stats is expensive, so we update GUI only once a second
    my $updated = 0;
    sub update {
	my($force) = @_;
	$force and $updated = 1;
	$mw->update;		# let GUI work while we are busy
	time > $updated or return;
	$picasa->{root} and $picasa->{file} or return;

	# warn "updating $File::Find::name\n" if $conf->{debug};
	$picasa->{file} =	# update current statistics
	    $picasa->filter("$picasa->{file}{dir}$picasa->{file}{file}");
	&move;			# updates statistics on GUI
	$sofar = $picasa->{sofar};
	$sofar < $pg->cget('-to') or
	    $pg->configure(-to => $sofar + 1000);
	$updated = time;
    }
}

sub nums {	# format the counts of attributes; upcase if filtering
    my $this = shift;
    my $out = sprintf "%ds %du %df %da %dc %dt",
    $this->{stars},
    $this->{uploads},
    $this->{faces},
    $this->{albums},
    $this->{caption} =~ /^\d+$/ ? $this->{caption} : $this->{caption} ? 1 : 0,
    $this->{tags};
    $conf->{filtering} = scalar
	grep { $conf->{filter}{$_} and /^([A-Z])/ and $out =~ s/($1)/\U$1\E/i }
    keys %{$conf->{filter}};
    $conf->{filter}{age} and ++$conf->{filtering} and
	$out .= " $age{$conf->{filter}{age}}";
    $l{nw}->configure($conf->{filtering} ? (-fg => 'white', -bg => 'red') : @c);
    return ($conf->{filtering} || $out =~ /[1-9]/ ? $out : '');
}

sub stats {			# format the [average] image metrics
    my($this, $x, $y, $scale) = @_;
    my $w = $this->{width} / $this->{files};
    my $h = $this->{height} / $this->{files};
    $scale = $x / $w < $y / $h ? $x / $w : $y / $h
	unless $scale;
    $scale *= 2 / 3 if $this->{file} =~ m!/$!;

    $conf->{info} == 1 and $x == $mx and
	return sprintf '%.0f%%', 100 * $scale;

    return sprintf "%.0f KB (%.0f KP) %.0f x %.0f (%.3f) %.0f%%",
    $this->{bytes} / 1024 / $this->{files},
    $this->{pixels} / 1000 / $this->{files},
    $w, $h, $w / $h, 100 * $scale;
}

sub scroll {			# move browser to current selection
    return unless $picasa->{index} >= 0;
    $tg->see(int($picasa->{index} / $tnx + 1), # Table index begins at 1, not 0!
	     $picasa->{index} % $tnx + 1);
}

sub move {		       # move browser to new directory or file
    &scroll;
    return unless my $current = $picasa->{file};
#    warn "location: $picasa->{dir}{dir} $picasa->{dir}{file} - $picasa->{file}{dir} $picasa->{file}{file} ($picasa->{index})\n" if $conf->{debug};
    return unless $current->{files} and $current->{bytes};

    $mw->title("PG: $picasa->{file}{dir}");

    # update background of previous and next tile locations
    for my $i ($picasa->{pindex}, $picasa->{index}) {
	my $dir = $picasa->{dir}{children}[$i] || 0;
	$dir and $dir = $dir =~ m@/$@;
	my $w = $tg->get(int($i / $tnx + 1), $i % $tnx + 1) or next;
	$w->configure(-bg => $i == $picasa->{index} ? $conf->{select}
		      : $dir ? $conf->{dbg} : $conf->{bg});
    }
    $mw->update;		# needed?
    $l{$_}->configure(@c) for qw/nw n ne se s sw/;

    $s{n} = $current->{file};
    $s{n} =~ s/$current->{time}-//; # unless $s{n} =~ m!/$!;

    $s{nw} = $s{n} =~ m@/$@ ? sprintf "%.0f MB (%.0f MP) in %d files",
    $current->{bytes} / 1024 / 1024,
    $current->{pixels} / 1000 / 1000,
    $current->{files} : '';
    my $tmp = &nums($current);
    $s{nw} .= " ($tmp)" if $tmp;
    $s{nw} or $s{nw} = '<--back';
    $s{nw} .= ' ';

    $s{ne} = ' ' . &stats($current, $tpx, $tpy); # red = update in progress
    $l{ne}->configure($picasa->{done} ? @c : (-fg => 'white', -bg => 'red'));

    my $total = @{$picasa->{dir}{children}};
    my $cur = $picasa->{index} + 1;
    $s{s} = "$current->{dir} $cur / $total";

    $s{sw} = $current->{time};
    $s{se} = $ss->time ? sprintf("$conf->{slideshow} %d / %d (%d%s) ",
				 $ssindex + 1, scalar @ss,
				 $conf->{delay}, $conf->{random} ? 'r' : '')
	: ($current->{time} eq $current->{endtime}) ? $current->{caption} || ''
	: $current->{endtime};
    $s{se} or $s{se} = '(menu)';
    $l{se}->configure($ss->time ? (-fg => $conf->{ssc}) : @c);
}

# sort by distance from current selection to update visible tiles first
sub isort {
    return sort { abs($picasa->{index} - $a) <=>
		      abs($picasa->{index} - $b) } @_;
}

sub newdir {		 # replace all thumbnails in current directory
    my $now = "$picasa->{dir}{dir}$picasa->{dir}{file}";
    $now =~ s@/+@/@g;
    $refreshing eq $now and return;
    # warn "\n\nnewdir $now\n" if $conf->{debug};
    $ss->time and $conf->{random} and return; # too expensive to cd often
    $mw->raiseFocus unless $conf->{slideshow};
    &move;
    for my $row (1 .. $tg->totalRows) { # blank previous thumbs
	for my $col (1 .. $tg->totalColumns) {
	    if (my $w = $tg->get($row, $col)) {
		$w->cget(-image)->blank;
		$w->configure(-bg => $conf->{bg});
	    }
	}
    }
    $refreshing = $now;
    my $location = -1;		# current browser position
    my $index;			# current tile number updating
    my @index = 0 .. @{$picasa->{dir}{children}} - 1;
    while (@index) {
	@index = &isort(@index) if $picasa->{index} != $location;
	$location = $picasa->{index};
	$index = shift @index;
	my $now = "$picasa->{dir}{dir}$picasa->{dir}{file}";
	$now =~ s@/+@/@g;	# bail out if user moved location
	$refreshing eq $now or return;

	my $img = $picasa->{dir}{children}[$index];
        my $child = "$now$img";
	my $this = $picasa->filter($child, 'nofilter');
	my $pf = $this->{physical};
	my $data = $picasa->{pics}{$pf};
	my $row = int($index / $tnx) + 1, # Table index begins at 1, not 0!
	my $col = $index % $tnx + 1,
	my $w;
	unless ($w = $tg->get($row, $col)) { # connect 1 photo to each cell once
	    $w = $tg->Label(-width => $tpx, -height => $tpy, -image =>
			    $mw->Photo(-width => $tpx, -height => $tpy),
			    -bg => $conf->{bg});
	    $tg->put($row, $col, $w);
	}
	my $image = $w->cget(-image); # replace cell's photo
	if ($img =~ m!/$!) {	# directory: stack some pics
	    $w->configure(-bg => $conf->{dbg});
	    $child =~ s@/$@@;
	    &StackXYthumb($image, $child, (map { int } $tpx, $tpy),
			  "$img ($this->{files})", $this->{mtime},
			  $this->{first}, $this->{physical}, $this->{last});
	} else {
	    $w->configure(-bg => $conf->{bg});
	    &PhotoXYthumb($image, $pf, (map { int } $tpx, $tpy),
			  $data->{caption} || 0, $child, $data->{rot});
	}
        $w->update; # Display the thumbnail
	&move;    # toward selection while thumbnails are generating
    }
    $refreshing = "";
}

sub min {
    return (sort { $a <=> $b } @_)[0];
}
sub max {
    return (sort { $b <=> $a } @_)[0];
}

sub info {			# cycle information overlay level
    $conf->{info}++;
    $conf->{info} > 2 and $conf->{info} = 0;
    &newpic;
}

sub newpic {	     # replace the full picture with current selection
    &move unless $ss->time and $conf->{random};
    $ss->time or $full->focusCurrent eq $full or return;
    my $this = $picasa->{file} or return;
    if ($this->{file} =~ m!/$!) { # raise browser to see directory option
	&newdir;
	return;
    }
    my $pf = $this->{physical} or return;
    my $data = $picasa->{pics}{$pf} or return; # data of this picture
    my $x = $data->{width} or return;
    my $y = $data->{height} or return;
    $scale = $conf->{pan} ?
	&max($mx / $x, $my / $y) :
	&min($mx / $x, $my / $y);
    $conf->{pan} == 2 and $scale = 1;
    # cap max zoom at 10X physical display to prevent "thin" image
    # (e.g. 1x2000) from going to Gigapixels and consuming massive memory:
    $scale = 10 * $mx / $x if $scale * $x > 10 * $mx;
    $scale = 10 * $my / $y if $scale * $y > 10 * $my;
    &PhotoXYfull($image, $pf, (map { int } $scale * $x, $scale * $y), $data->{rot})
	or return;
    my($X, $Y) = ($mx/2 - ($scale * $x)/2, $my/2 - ($scale * $y)/2);
    $conf->{overlay} and $X = $Y = 0;
    $canvas->coords('image', $X, $Y);
    $full->title("PG: $picasa->{file}{file}");

    my @all = qw/bg fg faces view help pos/;
    map { $canvas->delete($_) } @all;

    $pos and $pos->cancel;	# cancel position remover
    my $total = @{$picasa->{dir}{children}};
    my $bar = $mx / $total;	# progress bar
    $canvas->createLine($bar * $picasa->{index}, 2,
			$bar * $picasa->{index} +
			($bar > 5 ? $bar : 5), 2,
			-fill => $conf->{title},
			qw/-width 5 -tags pos/);
    if (@ss) {
	my $bar = $mx / @ss;
	$canvas->createLine($bar * $ssindex, 2,
			    $bar * $ssindex +
			    ($bar > 5 ? $bar : 5), 2,
			    -fill => $conf->{ssc},
			    qw/-width 5 -tags pos/);
    }
    unless ($conf->{info}) {	# bypass info overlay
	$pos = $full->after(2000, sub { $canvas->delete('pos') });
	$conf->{pan} and &picmove(0, 0);
	return;
    }
    if ($conf->{info} > 1 and my $info = $exif->ImageInfo($pf)) {
	my @info;
	push @info, $info->{Make} if $info->{Make};
	push @info, $info->{Model} if $info->{Model};
	push @info, "$info->{ExposureTime}s" if $info->{ExposureTime};
	push @info, $info->{FocalLength} if $info->{FocalLength};
	push @info, "($info->{FocalLengthIn35mmFormat})"
	    if $info->{FocalLengthIn35mmFormat};
	push @info, "f/$info->{FNumber}" if $info->{FNumber};
	push @info, "ISO: $info->{ISO}" if $info->{ISO};
	push @info, $info->{Flash} if $info->{Flash};
	push @info, $info->{Orientation} if
	    $info->{Orientation} and $info->{Orientation} =~ /Rotate/;
	$canvas->createTextBox($mx, $my, $conf->{bg},
			       -justify => 'right',
			       -anchor => 'se',
			       -font => $font,
			       -fill => $conf->{text},
			       -text => (join " \n", @info),
			       -tags => 'fg');
    }
    if ($conf->{attrs} and my $info = $conf->{attrs}{$pf}) {
	my @info;
	push @info, $info->{n} if defined $info->{n};
	push @info, $info->{a} if $conf->{info} > 1 and $info->{a};
	$canvas->createTextBox($mx, $my, $conf->{bg},
			       -justify => 'right',
			       -anchor => 'se',
			       -font => $font,
			       -fill => $conf->{text},
			       -text => (join " \n", @info),
			       -tags => 'fg');
    }
    $canvas->createTextBox($mx, 0, $conf->{bg},
			   -justify => 'right',
			   -anchor => 'ne',
			   -font => $font,
			   -fill => $conf->{text},
			   -text => &stats($this, $mx, $my, $scale),
			   -tags => 'fg');
    (my $file = $this->{file}) =~ s/$this->{time}-//;
    my $text = "$this->{dir}\n$file\n$this->{time}";
    $text .= "\n$this->{endtime}" if $this->{time} ne $this->{endtime};
    my $tmp = &nums($this);
    $text .= "\n($tmp)" if $tmp;
    $text .= "\n" . join "\n", keys %{$this->{tag}} if keys %{$this->{tag}};
    $conf->{info} == 1 and $text = $this->{time};
    $canvas->createTextBox(0, 0, $conf->{filtering} ? 'red' : $conf->{bg},
			   -anchor => 'nw',
			   -font => $font,
			   -fill =>
			   $conf->{filtering} ? 'white' : $conf->{text},
			   -text => $text,
			   -tags => 'fg');
    if ($conf->{info} > 1) {
	$text = join "\n", split '/', $pf;
	$text = join "\n", "$text\n", map { $picasa->{album}{$_}{name} }
	keys %{$this->{album}};
	$canvas->createTextBox(0, $my, $conf->{bg},
			       -anchor => 'sw',
			       -font => $font,
			       -fill => $conf->{text},
			       -text => $text,
			       -tags => 'fg');
    }
    my $cur = $picasa->{index} + 1;
    $text = " $cur / $total ";
    $canvas->createTextBox($mx / 2, 0, $conf->{bg},
			   -anchor => @ss ? 'nw' : 'n',
			   -font => $font,
			   -fill => $conf->{title},
			   -text => $text,
			   -tags => 'fg');
    if (@ss) {
	$text = sprintf " %d / %d (%d%s) ", $ssindex + 1, scalar @ss,
	$conf->{delay}, $conf->{random} ? 'r' : '';
	$canvas->createTextBox($mx / 2, 0, $conf->{bg},
			       -anchor => 'ne',
			       -font => $font,
			       -fill => ($ss->time ? $conf->{ssc} : 'white'),
			       -text => $text,
			       -tags => 'fg');
    }

    if ($this->{caption}) {
	$canvas->createTextBox($mx / 2, $my, $conf->{bg},
			       -width => $mx,
			       -anchor => 's',
			       -font => $font,
			       -fill => $conf->{title},
			       -text => $this->{caption},
			       -tags => 'fg');
    }

    if ($conf->{info} > 1) {
	for my $id (keys %{$this->{face}}) { # named rectangles around faces!
	    my($l, $t, $r, $b) = @{$this->{face}{$id}};
	    my $name = $picasa->contact2person($id);
	    $canvas->createRectangle($X + $l * $x * $scale, $Y + $t * $y * $scale,
				     $X + $r * $x * $scale, $Y + $b * $y * $scale,
				     -outline => $conf->{face},
				     -tags => 'faces');
	    $canvas->createText($X + $l * $x * $scale + 2, $Y + $t * $y * $scale,
				-anchor => 'nw',
				-font => $font,
				-fill => $conf->{face},
				-text => $name,
				-tags => 'faces');
	    if (my $birth = $conf->{birthday}{$id} # show ages of faces :-)
		|| $conf->{birthday}{$name}) {
		my($yr, $m, $d) = split '/', $birth;
		my($Yr, $M, $D) = split /\D+/, $this->{time};
		my($year, $mon, $day) = delta_ymd($yr, $m, $d, $Yr, $M, $D);
		# warn "age $id/$name: $Yr, $M, $D - $yr, $m, $d = $year, $mon, $day\n"
		# 	if $conf->{debug};
		my $age;
		my $days = delta_days($yr, $m, $d, $Yr, $M, $D);
		if ($days < 92) { # 31 + 31 + 30 will always get to third month
		    $age = sprintf "%dd", $days;
		} elsif ($days < 366 * 3) { # show months below age 3 years
		    $age = sprintf "%dm", int($year*12 + $mon + $day/365.25/12);
		} else {
		    $age = sprintf "%d", int($year + $mon / 12 + $day / 365.25);
		}
		$canvas->createText($X + $r * $x * $scale - 2,
				    $Y + $b * $y * $scale,
				    -justify => 'right',
				    -anchor => 'se',
				    -font => $font,
				    -fill => $conf->{face},
				    -text => $age,
				    -tags => 'faces');
	    }
	}
    }
    $canvas->raise('pos', 'image||bg');
    $conf->{pan} and &picmove(0, 0);
}

# Time::Local is more likely to be installed than Date::Calc
sub delta_ymd {
    my($y, $m, $d, $Y, $M, $D) = @_;
    return $Y - $y, $M - $m, $D - $d;
}
sub delta_days {
    my($y, $m, $d, $Y, $M, $D) = @_;
    my $begin = timegm(0, 0, 12, $d, $m - 1, $y);
    my $end = timegm(0, 0, 12, $D, $M - 1, $Y);
    return int(($end - $begin) / 24 / 60 / 60 + 0.5);
}

{
    my %cache;			# {file}{name} => [id, geometry]
# return the geometry of $path's face in $file, storing ID in $idref
sub cropface {
    my($file, $path, $idref) = @_;
    $conf->{facecrops} or return '';
    $path =~ m@\[People\]/([^/]+)@ or return '';
    my $face = $1;
    my $this = $picasa->{pics}{$file} or return '';
    unless ($cache{$file}{$face}) {
	$cache{$file}{$face} = [0, ''];
#	warn "cropface: $file for $path ($face)\n";
	for my $id (keys %{$this->{face}}) {
	    if ($picasa->contact2person($id) eq $face) {
		my($l, $t, $r, $b) = @{$this->{face}{$id}};
#		warn "\t$id: $l, $t, $r, $b\n";
		$cache{$file}{$face} = [
		    $id, sprintf "[%dx%d+%d+%d]",
		    ($r - $l) * $this->{width}, ($b - $t) * $this->{height},
		    $l * $this->{width}, $t * $this->{height} ];
		last;
	    }
	}
    }
    my($id, $geo) = @{$cache{$file}{$face}};
#    warn "cropface: $id, $geo\n";
    $idref and $$idref = $id;
    return $geo;
}

# return the geometry to crop $file to fully fill $x/$y thumbnail
sub cropthumb {
    my($file, $x, $y) = @_;
    $conf->{thumbcrops} or return '';
    my $this = $picasa->{pics}{$file} or return '';
    my $geo = "$x-$y";
    unless ($cache{$file}{$geo}) {
	my($w, $h) = ($this->{width}, $this->{height});
	my $af = $w / $h;	# aspect full
	my $at = $x / $y;	# aspect thumb
	if ($af > $at) {	# wider than thumb: discard left/right
	    $cache{$file}{$geo} = sprintf "[%dx%d+%d+%d]",
	    $h * $at, $h, ($w - $h * $at) / 2, 0;
	} else {	       # taller than thumb: discard top/bottom
	    $cache{$file}{$geo} = sprintf "[%dx%d+%d+%d]",
	    $w, $w / $at, 0, ($h - $w / $at) / 2;
	}
    }
    return $cache{$file}{$geo};
}
# return the geometry of $file cropped by current settings
sub cropfile {
    my($file, $path, $x, $y, $idref) = @_;
    if ($path =~ m@\[People\]/@) {
	return &cropface($file, $path, $idref) || &cropthumb($file, $x, $y);
    }
    return &cropthumb($file, $x, $y);
}
}

# read $f file into $w image scaled to size $x / $y, with cacheing
sub PhotoXYthumb {
    my ($w, $f, $x, $y, $c, $v, $rot) = @_;
    $f && $x && $y or return;
    my $ext = 'jpg';		# jpg is smaller than png
    my $cfn = "$conf->{cache}/$x-$y/";
    my $id = 0;
    my $crop = &cropfile($f, $v, $x, $y, \$id);
    if ($id) {			# face crop of variable aspect
	$cfn .= "face/$id/";
    } elsif ($crop) {		# crop to fill tiles
	$cfn .= 'crop/';
    } else {			# full pictures + space in tiles
	$cfn .= 'full/';
    }
    $cfn .= "$f.$ext";
    unless (!$rebuildthumb{$f} && -f $cfn && -f $f
	    && abs((stat $cfn)[9] - (stat $f)[9]) < 3) {
	delete $rebuildthumb{$f};
	-f $cfn and unlink $cfn;
	my($dir, $file) = Picasa::dirfile($cfn);
	-d $dir or mkpath $dir or warn "can't mkdir $dir: $!\n";
	my $geo = "${x}x${y}";
	my $im;
	chomp $c;
	if ($c) {		# caption on thumbnail
	    $im = &image('xc:#0000', size => $geo);
	    $im->Composite(qw/gravity northwest image/ =>
			   &image("$f$crop", size => $geo, rot => $rot));
	    $im->Composite(qw/gravity south image/ =>
			   &image("caption:$c",
				  qw/fill white gravity south background/,
				  '#0006', size => $tpx . 'x' . int($tpy / 6)));
	} else {
	    $im = &image("$f$crop", size => $geo, rot => $rot);
	}
	my $e = $im->Write($cfn); $e and warn $e;
	my($time) = -f $f ? (stat $f)[9] : 1; # timestamp same as source file
	utime $time, $time, $cfn;
    }
    $w->blank;
    $w->read($cfn);
}

# 3 @pics stacked into $w image of size $x / $y, with cacheing as $f
sub StackXYthumb {
    my ($w, $f, $x, $y, $label, $time, @pic) = @_;
    $f && $x && $y && @pic or return;
    my $ext = 'png';		# jpg isn't transparent; use png
#    my $ext = 'jpg';		# but png is >4X larger; use jpg
    my $cfn = "$conf->{cache}/$x-$y/";
    my $id = 0;
    my $crop = &cropfile($pic[0], $f, $x, $y, \$id);
    if ($id) {			# face crop of variable aspect
	$cfn .= "face/$id/";
    } elsif ($crop) {		# crop to fill tiles
	$cfn .= 'crop/';
    } else {			# full pictures + space in tiles
	$cfn .= 'full/';
    }
    $cfn .= "$f.$ext";
    unless (!$rebuildthumb{$f} && -f $cfn
	    && abs((stat $cfn)[9] - $time) < 3) {
	delete $rebuildthumb{$f};
	-f $cfn and unlink $cfn;
	my($dir, $file) = Picasa::dirfile($cfn);
	-d $dir or mkpath $dir or warn "can't mkdir $dir: $!\n";
	my $geo = sprintf "%.0fx%.0f", $x * 2 / 3, $y * 2 / 3;

	my $im = &image('xc:#0000', size => "${x}x${y}");
	my @pos = qw/northwest center southeast/;
	my %uniq;
	for my $p (grep !$uniq{$_}++, @pic) {
	    $im->Composite(gravity => shift @pos, image =>
			   &image($p . &cropfile($p, $f, $x, $y, \$id),
				  size => $geo, rot => $picasa->{pics}{$p}{rot}));
	}
	$im->Composite(qw/gravity center image/ =>
		       &image("caption:$label",
			      qw/fill white gravity center background/, '#0006',
			      size => sprintf("%.0fx%.0f", $x, $y / 5)));
	$im->Thumbnail("${x}x${y}");
	my $out = $cfn;
	if ($ext =~ /png/) { # compress PNG while preserving transparency
	    $im->Set(qw/background hotpink alpha background/);
	    $out = "png24:$cfn";
	}
	my $e = $im->Write($out); $e and warn $e;
	utime $time, $time, $cfn;
    }
    $w->blank;
    $w->read($cfn);
}

# read $f file into $w image scaled to size $x / $y
BEGIN {
    my $id = 10000;
    my $ext = 'jpg';		# full format
    sub PhotoXYfull {
	my ($w, $f, $x, $y, $rot) = @_;
	$f && $x && $y or return;
	my $cfn = "$conf->{cache}/tmp-$$-" . $id++ . ".$ext";
	my $geo = "${x}x${y}";
	my $im = &image($f, size => $geo, rot => $rot);
	my $e = $im->Resize(geometry => $geo); $e and warn $e;
	$e = $im->Write($cfn); $e and warn $e;

	$w->blank unless $conf->{overlay}; # overlay opposite corner mode
	$w->read($cfn, ($conf->{overlay} && !$conf->{pan} && $id % 2)
		 ? (-to => $mx - $x, $my - $y)
		 : ());
	$cfn =~ s/.$ext/*.$ext/;
	unlink glob $cfn;
	return 1;
    }
}

# return the $file or its error message in an Image::Magick object
sub image {
    my($file, %opt) = @_;
    my $rot = $opt{rot} || 0; delete $opt{rot};
    my $i = Image::Magick->new(%opt);
    # crop while reading unless rotated, in that case, crop later!
    my $crop = 0; $crop = $1 if $rot and $file =~ s/\[(\S+)\]$//;
    my $e = $i->Read($file);
    if ($e) {
	warn $e;      # opts are last-one-wins, so we override colors:
	$i = Image::Magick->new(%opt,
				qw/background red fill white gravity center/);
	$i->Read("caption:$e");	# put error message in the image
	$rot = 0;
    }
    $rot and $i->Rotate($rot);	# must crop after rotate
    $crop and $i->Crop(geometry => $crop);
    $opt{size} and $i->Resize(geometry => $opt{size});
    $i->Strip;			# strip exif for smaller files
    return $i;
}

# createText on a box of given color $c (since we have no transparency)
# sub Tk::Canvas::createTextBox {
#     my($w, $x, $y, $c, %opt) = @_;
#     my $t = $w->createText($x, $y, %opt);
#     my @opt;
#     push @opt, (-tags => $opt{'-tags'}) if $opt{'-tags'};
#     $w->createRectangle($w->bbox($t), -fill => $c, @opt);
#     $w->raise($t);
# }
# createText with background of given color $c (since we have no transparency)
sub Tk::Canvas::createTextBox {
    my($w, $x, $y, $c, %opt) = @_;
    my @text = split "\n", $opt{-text}; # we will draw 1 line at a time
    my $dir = 1;
    if ($opt{-anchor} && $opt{-anchor} =~ /s/i) {
	@text = reverse @text;	# south anchors must work bottom-up
	$dir = -1;
    }
    for my $text (@text) {     # lines, top to bottom or bottom to top
	$opt{-text} = $text;
	my $txt = $w->createText($x, $y, %opt);
	my($l, $t, $r, $b) = $w->bbox($txt);
	$w->createRectangle($l, $t, $r, $b, -fill => $c, -tags => 'bg');
	$y += $dir * ($b - $t);	# location of next line
	$w->raise($txt);	# text in front of box
    }
}

# Toggle fullscreen by hiding decorations off-screen. I prefer this to
# overrideredirect(1) which loses focus and Alt-Tab WM controls.
{
    my %geom;			# remember size/pos before full screen
    sub togglefullscreen {
	my($w) = @_;
	my($offx, $offy) = ($w->rootx, $w->rooty);
	my($sw, $sh) = ($w->screenwidth, $w->screenheight);
	my($dx, $dy) = ($offx - $offx % $sw, $offy - $offy % $sh);
	if ($offx % $sw || $offy % $sh) { # not at 0, 0 == not full screen
	    $geom{"$w"} = $w->geometry; # size/location to restore
	    $w->maxsize($sw, $sh);
	    $w->geometry(sprintf "%dx%d+%d+%d", $sw, $sh, $dx, $dy);
	    $w->update;
	    ($offx, $offy) = ($w->rootx, $w->rooty); # decoration offsets
	    ($dx, $dy) = ($dx + ($dx - $offx), $dy + ($dy - $offy));
	    $w->geometry(sprintf "%dx%d+%d+%d", $sw, $sh, $dx, $dy);
	    $w->attributes(-fullscreen => 1) # works on mythbuntu!
		if grep /-fullscreen/, $w->attributes;
	    $w->raiseFocus;
	} else {		# at 0, 0 == already full screen
	    $w->geometry($geom{"$w"});
	    $w->attributes(-fullscreen => 0)
		if grep /-fullscreen/, $w->attributes;
	    $w->raiseFocus;
	}
    }
}

# raise window $w and ensure it has focus
sub Tk::raiseFocus {
    my($w) = @_;
    $w->deiconify;
    $w->raise;			# causes menu @ 0,0 on Windows??!
    $w->focus;
    $w->grab unless $^O =~ /MSWin/;
    $w->update;
    $cur = $w unless Exists $m{m} and $w eq $m{m}; # focus to restore after menu
}
__END__

=pod

=head1 NAME

picasagallery - .picasa.ini aware keyboard driven picture browser

=head1 SYNOPSIS

picasagallery [field=value]

=head1 DESCRIPTION

B<picasagallery> presents local pictures (optionally managed by
Picasa) in a keyboard (or remote) controlled browser, similar to
mythgallery of mythtv.  It does so by caching picture metadata from
the filesystem and presenting a "virtual filesystem" as a grid of
thumbnail images for navigation.  The goal is to have access to more
picture metadata including several ways to organize and filter the
images.

=head2 Thumbnail Grid

The main window is a grid of thumnail images.  Directories are
represented by a stack of three images: the oldest, center and
youngest picture in the directories below that point in the tree.
Arrow keys move around the grid while the B<Enter> key presents a
single picture or moves into a subdirectory and the B<Escape> key
moves back up to the parent.  Metadata about the selected tile is
displayed above and below the grid.

The top level virtual directories are:

=over

=item [Folders]

literal filesystem layout of picture files

=item [Tags]

tag strings found in Exif picture metadata

=item [Albums]

pictures organized by Albums (Picasa only)

=item [People]

thumnails of named face rectangles from the images (Picasa only)

=item [Stars]

pictures marked with stars as favorites (Picasa only)

=back

=head2 Image Viewer

A second window opens when hitting B<Enter> on an image from the grid.
This displays one picture at maximum size for the window.  B<Enter>
again will zoom to maximize width or height or zoom to original size.
Scrol with the arrow keys for images larger than the window.
B<Escape> then returns to the thumbnail browser.

The B<i> "info" key cycles through metadata overlay levels.  This
draws named rectables around all recognized faces and presents common
camera metadata in the corners.

=head1 OPTIONS

The B<M> key brings up a Menu of options including filtering, starting
a slide show and so on.

See the header of bin/picasagallery for field=value options that can
be given on the command line or in the config file.

=head1 FILES

=over

=item .picasapgallery_conf.pl

perl config file must return a reference to a configuration hash; see
the top of bin/picasagallery for startup options.

=back

=head1 CAVEATS / WARNINGS

This is currently works-for-me-ware which may not work for you.  It is
incomplete and inefficient for very large picture collections.  I hope
to resolve this someday with a re-write including a SQLite database
backend and a Prima GUI frontend.  This should reduce the memory
footprint and improve the interface.

=head1 EXAMPLES

picasagallery

picasagallery fast=1

=head1 SEE ALSO

https://en.wikipedia.org/wiki/Picasa

=head1 AUTHOR

Timothy D Witham <twitham@sbcglobal.net>

=head1 COPYRIGHT AND LICENSE

Copyright 2013-2018 Timothy D Witham.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
