view release on metacpan or  search on metacpan

iv  view on Meta::CPAN

    $loc;
    } # loc

sub bind_wheel {
    my ($w, $sw, $u) = @_;

    $w->bind ($_, sub { $sw->yview (scroll => -$u, "units") }) for "<4>", @{$Option{keys_scroll_up}};
    $w->bind ($_, sub { $sw->yview (scroll =>  $u, "units") }) for "<5>", @{$Option{keys_scroll_down}};
    $w->bind ($_, sub { $sw->xview (scroll => -$u, "units") }) for "<6>", @{$Option{keys_scroll_left}},  "<Alt-Button-4>", "<Control-Button-4>", "<Shift-Button-4>";
    $w->bind ($_, sub { $sw->xview (scroll =>  $u, "units") }) for "<7>", @{$Option{keys_scroll_right}}, "<Alt-Button-5>", "<Control-Button-5>", "<Shift-Button-5>";
    } # bind_wheel

my $pxyid = 10000;

sub Tk::PhotoXY {
    my ($w, $f, $x, $y, $r, $p) = (@_, 0);
    $f && $x && $y or return;
    my ($cfh, $cfn) = tempfile ("iv#$$-XXXXXX", DIR => $tmp);
    my ($rx, $ry) = $r == 90 || $r == 270 ? ($y, $x) : ($x, $y);
    my $geo = "${rx}x${ry}";
    my @rot = $r ? ("-rotate", $r) : ();
    system "convert", "-size", $geo, "-resize", "$geo+0+0", @rot, $f, "$cfn.jpg";
    # convert generates multiple files for animated images
    my @cfn = glob "${cfn}*jpg*";
    if (@cfn) {
	eval { $p = $w->Photo (-file => $cfn[0]) };
	unlink @cfn;
	}
    $p;
    } # PhotoXY

my @rm_cfn;
END { -f $_ && unlink $_ for @rm_cfn; }

# 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",