App-tkiv

 view release on metacpan or  search on metacpan

iv  view on Meta::CPAN

    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 )