view release on metacpan or  search on metacpan

iv  view on Meta::CPAN

eval "use Tk::TIFF;";
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 File::Temp qw( tempdir tempfile );
use File::Copy;
#use Data::Peek;

			# Time to fetch image dimensions for 3500 images
our $exiftool = 0;	# 26.5
our $iinftool = 0;	#  4.5
our $imsztool = 0;	#  0.2
our $exiftran = 0;
eval {
    require Image::ExifTool;
    Image::ExifTool->import ("ImageInfo");
    $exiftool = Image::ExifTool->new ();
    };
eval {
    require Image::Size;
    Image::Size->import ("imgsize");
    $imsztool = exists &imgsize;
    };
eval {
    require Image::Info;
    Image::Info->import ("image_info", "dim");
    $iinftool = exists &image_info;
    };
-x "/usr/bin/exiftran" and $exiftran = 1;

my $tmp = tempdir (CLEANUP => 1);
my $pic = @ARGV && -f $ARGV[-1] && $ARGV[-1] =~ s{/([^/]+)$}{} ? $1 : "";
   $pic and $opt_1 = 0;

{   my @opt;
    my @ivrc_dirs = ("/etc", $ENV{HOME});
    if (@ARGV && -d $ARGV[-1]) {
	push @ivrc_dirs, $ARGV[-1], $ARGV[-1];
	$ivrc_dirs[-1] =~ s{/[^/]+/?$}{};
	}
    foreach my $dir (@ivrc_dirs) {
	-d $dir or next;
	foreach my $rcf ("iv.rc", ".ivrc") {
	    open my $of, "<", "$dir/.ivrc" or next;
	    $opt_v and warn "Reading $dir/.ivrc\n";
	    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 $def_sls = $Option{slideshowdelay}; # 1.5 sec / pic

# Main Window
my $mw = Tk::MainWindow->new (-title => "iv");

# Screen dimensions
my ($cx, $cy) = ($mw->screenwidth, $mw->screenheight);
eval { # Use both methods, as the WM might return bogus values after having
       # been resized e.g. for beamer output
    require X11::Protocol;
    my $x11 = X11::Protocol->new ();
    my $screen = ($ENV{DISPLAY}||":0.0") =~ m/\.(\d+)$/ ? $1 : 0;
    $x11->choose_screen ($screen); # Root window
    my ($xx, $xy) = ( $x11->{width_in_pixels}, $x11->{height_in_pixels} );
    $xx > $cx and $cx = $xx;
    $xy > $cy and $cy = $xy;
    };
$Option{real_cx} = $cx;
$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

# 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 );
{   my $rb = -(($Option{real_cx} >= $Option{maxx} ? ($Option{real_cx} - $Option{maxx}) : 0) + 2);
    @loc{@loc} = (
	"+2+2", "+X+2", "$rb+2", "$rb+Y", "$rb-2",
	"+X-2", "+2-2", "+2+Y",  "+X+Y",  "+X+Y",
	);
    }

# Selections and tools

iv  view on Meta::CPAN

# Cropping version
sub Tk::PhotoXYXY {
    my ($w, $f, $x, $y, $X, $Y, $p) = (@_, 0);
    $f && $x && $y or return;
    my ($cfh, $cfn) = tempfile ("iv#$$-XXXXXX", DIR => $tmp);
    my ($dx, $dy) = ($X - $x, $Y - $y);
    my $geo = "${dx}x$dy+$x+$y";
    my $q = $f =~ m/'/ ? '"' : "'";
    system qq{convert -crop $geo $q$f$q $cfn.jpg};
    # convert generates multiple files for animated images
    my @cfn = glob "${cfn}*jpg*";
    if (@cfn) {
	eval { $p = $w->Photo (-file => $cfn[0]) };
	my $_fn = shift @cfn;
	$selection{file} = $_fn;
	push @rm_cfn, $_fn;
	@cfn and unlink @cfn;
	}
    $p;
    } # PhotoXYXY

sub show_exifinfo {
    my $w  = shift or return;
    $w->delete ("exifinfo");
    $Option{showexifinfo} or return;
    my $ei = shift or return;
    my $dto = $ei->{DateTimeOriginal} // "";
    my $iso = $ei->{ISO} ? "ISO $ei->{ISO}" : "";
    my $spd = $ei->{ShutterSpeed} // $ei->{exposureTime} // "";
    my $ape = $ei->{Aperture} // $ei->{FNumber};
       $ape = $ape ? "F$ape" : "";
    my $fln = $ei->{FocalLengthIn35mmFormat} // $ei->{FocalLength} // "";
    $w->createText (5, 5,
	-anchor => "nw",
	-fill   => $Option{exifinfocolor},
	-font   => $Option{smallfont},
	-text   => join ("\x{00b7}", grep m/\S/, $dto, $iso, $ape, $spd, $fln),
	-tags   => "exifinfo",
	);
    if ($dto) {
	my $awb =  $ei->{WhiteBalance} // "";
	my $fls = ($ei->{Flash} // $ei->{FlashFired} // "") =~
			m/^(yes|true|on|fired|1)\b/i ? "With flash" : "No flash";
	my $pgm =  $ei->{ExposureProgram} // 
		   $ei->{ShootingMode} //
		   $ei->{SceneMode} // "";
	my $sct =  $ei->{SceneType} // "";
	$w->createText (5, 20,
	    -anchor => "nw",
	    -fill   => $Option{exifinfocolor},
	    -font   => $Option{smallfont},
	    -text   => join ("\x{00b7}", grep m/\S/, $awb, $fls, $pgm, $sct),
	    -tags   => "exifinfo",
	    );
	$w->createText (5, 35,
	    -anchor => "nw",
	    -fill   => $Option{exifinfocolor},
	    -font   => $Option{smallfont},
	    -text   => join ("\x{00b7}" =>
		map { join " " => map { ucfirst lc $_ } split m/\s+/ => $_ }
		grep m/\S/, map { $ei->{$_} // "" }
		"Make",			# Nikon
		"Model",		# Coolpix S9700
		"DeviceType",		# Cell Phone
		"FileSource",		# Digital Camera
		),
	    -tags   => "exifinfo",
	    );
	}
    } # show_exifinfo

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))->pack (-expand => 1, -fill => "both");
    $ow->Subwidget ("${_}scrollbar")->configure (-width => 6) for qw( x y );
    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}};
	$W->bind ($_, \&exit) for @{$Option{keys_quit_all}};
	}
    } # show_exif