App-tkiv
view release on metacpan or search on metacpan
size => sub { $a->[2] <=> $b->[2] },
# 3. date
date => sub { $a->[3] <=> $b->[3] },
# 4. caseless image name
caseless => sub { $a->[4] cmp $b->[4] },
# 5. random
random => sub { $a->[5] <=> $b->[5] },
);
my $refreshing = "";
sub dtcmd {
# trigger $tn to show thumbnails of all pics in current dir
# Expansion also invokes this callback
@_ == 1 or return;
$idir = $_[0] or return ($refreshing = "");
my $Idir = realpath $idir;
#warn "dtcmd (idir = $idir ($Idir))\n";
$refreshing eq $Idir and return;
$refreshing = $Idir;
# Clean up previous pics
$iv && Exists ($iv) and $iv->destroy;
$bg && Exists ($bg) and $bg->destroy;
for (@tn) {
$_ && ref $_ && $_->{wdgt} && Exists ($_->{wdgt}) and
$_->{wdgt}->destroy ();
}
# New dir, reset globals
($tr, $or, $fr, $ti, $vs, $sls, $zs, $f11, @tn) = (0, 0, 0, -1, $opt_f, 0);
(my $ttl = $Idir) =~ s{^$ENV{HOME}}{~};
$ttl =~ s{^~/\.wine/fake_windows/}{:};
utf8::upgrade ($ttl);
$mw->title ($ttl);
my $tb = $tg->Balloon (
-state => "balloon",
-initwait => 1200, # 1.2 ms
-foreground => "Blue4",
-background => "LightYellow2",
);
# Gather all pics in this folder
opendir IDIR, $Idir;
my @img = map { $_->[0] }
sort { $tsort{$Option{thumbsorting}}->() }
map { my $seq = m/(\d+)/ ? $1 : 0;
[ $_, $seq, (stat "$Idir/$_")[7,9], lc $_, rand 1 ] }
grep { my $if = "$Idir/$_";
# Sanity check. Minimal image size 100
my $s = -s $if;
# Skip MacOS working copies
$if =~ s{/\._([^/]+)$}{/$1} && -s $if and $s = 0;
$s and $s > 100;
}
# convert can't deal with .ico files (yet)
# Tk can deal with Tiff/NEF as of 804.027_501 with Tk::TIFF
grep m/\.(jpe?g|gif|x[pb]m|png|bmp|tiff?|nef)$/i => readdir IDIR;
closedir IDIR;
$Option{thumbsortorder} =~ m/^(?:desc|reverse)/ and @img = reverse @img;
#my $t0 = [ gettimeofday ];
my $earlyopennextdir = $Option{lastfirstnext} || $opt_1;
if ($earlyopennextdir && opendir my $dh, "..") {
my @dir = readdir $dh;
@dir > 100 and $earlyopennextdir = 0; # too slow
}
$ni = @img;
$opt_v and warn "$ni images in $idir\n";
foreach my $img (@img) {
my $nt = @tn;
my $pf = "$Idir/$img";
my $ps = -s $pf or next;
$opt_v and warn "Read $pf ($ps) ...\n";
# Read it
my ($exif, $angl, $x, $y, $o) = ({}, 0, 0, 0);
if ($exiftool) {
$exif = ImageInfo ($pf);
#DDumper $exif;
if (ref $exif and exists $exif->{ImageWidth}) {
($x, $y) = ($exif->{ImageWidth}, $exif->{ImageHeight});
my $ori = $exif->{Orientation} || "Horizontal";
delete $exif->{$_} for qw( ThumbnailImage PreviewImage DataDump );
$ori =~ m/\b(-?\d+)\b/ and $angl = $1;
$angl < 0 and $angl += 360;
$exif->{Animated} = 0;
if ($exif->{FileType} eq "GIF" && $iinftool) {
my $info = image_info ($pf);
$exif->{Animated} = $info->{Delay} || 0;
}
}
}
if ($x == 0 and $imsztool) {
my ($w, $h) = imgsize ($pf);
$w and ($x, $y) = ($w, $h);
}
if ($x == 0 and $iinftool) {
my (@info) = image_info ($pf);
@info && ref $info[0] eq "HASH" && exists $info[0]{width} and
($x, $y) = ($info[0]{width}, $info[0]{height});
}
if ($x == 0) {
my $q = $pf =~ m/'/ ? '"' : "'";
my ($w, $h) = `identify -format "%w,%h" -quiet $q$pf$q` =~ m/([0-9]+)/g;
$w and ($x, $y) = ($w, $h);
}
$x && $y or next;
$opt_v > 4 and warn "Size: $x x $y\n";
# 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
( run in 0.922 second using v1.01-cache-2.11-cpan-df04353d9ac )