#!/usr/bin/perl -w
#
# losslesscrop.pl
# Written by Anthony DiSante
# Homepage: http://nodivisions.com/photos/apps/lossless-cropping/
# Contact: http://nodivisions.com/contact/
#
# Selection-box functionality based on / lifted from Ala Qumsieh's tutorial
# code at http://www.perltk.org/articles/
#
# This script provides a graphical frontend to the jpegtran utility which
# allows you to losslessly crop a JPEG image file.  It requires Perl, the
# Tk and Tk::JPEG perl modules, the jpegtran program with -crop switch, and
# the rdjpgcom program.  See homepage for details.
#
# Changelog:
#
# 20040925:
#
# The selection box now resizes properly when you zoom in/out on the image.
# The code depends on the $zoomin and $zoomout vars being set to 2, so don't
# change that.  Or else figure out a better way of determining/approximating
# the series by which to scale the coords as the image zoom changes.
#
# Also added print statements so that as you create/resize the selection box,
# its coords and size are shown (in the terminal) in realtime.
#
# 20031202:
#
# Made the move-selection-box logic work properly, after finding out from
# Ala Qumsieh that it's possible to both fill a selection box with color and
# have it be transparent.  The fill color gets hidden in that case, but the 
# box must have a fill in order to be movable.
#
# 20031130:
#
# Initial release.

use strict;
use Tk;
use Tk::JPEG;

##############################################################################
# User-definable variables:
#
# The name (optionally including path) of your jpegtran binary that accepts
# the -crop parameter:
my $cropcommand = 'jpegtran-crops';
# The initial width of the window:
my $windowwidth = 800; #1154;
# The initial height of the window:
my $windowheight = 600; #868;
#
# End of user-definable variables.
##############################################################################

my $file = $ARGV[0];

#print "
#Usage: use i/o keys to zoom, mouse button 3 to select an area, mouse button
#1 to resize the selection, and c key to crop. Outputs to a new file, with the
#same name as original except it has '-cropped' appended.\n";

print "
Use this to crop your JPEG images, losslessly.

i-key = zoom in
o-key = zoom out

right-click-and-drag: select area to crop
left-click-and-drag: resize your selected area

c-key = perform the crop

Outputs cropped image to a new file with '-cropped' at the end of the name.\n";

die "\nError: you must pass me a jpeg filename.\n\n" unless $ARGV[0];

my $dims = `rdjpgcom -v "$ARGV[0]"|grep 'JPEG image is'`;
my ($imgwidth, $imgheight) = ($dims =~ /(\d+)w \* (\d+)h/);

my $mw			= new MainWindow;
my $scalefactor		= 2;
my $box			= [0, 0, $imgwidth/$scalefactor, $imgheight/$scalefactor];
my $selection_exists	= 0;
my ($sf,$lastsf)	= (0,0);
my $selection;
my @selection_coords;
my $zoomin		= 2;
my $zoomout		= 2;


my $canv = $mw->Scrolled(qw/
			Canvas -bg black
			-confine 1
			-scrollbars se/,
			-width => $windowwidth,
			-height => $windowheight,
			-scrollregion => $box,
			)->pack(qw/-fill both -expand 1 -anchor nw/);


my $fullsize =  $canv->Photo( 'IMG', -file => $file );


my $img = $canv->Photo();
$img->copy($fullsize, -subsample => $scalefactor);
$canv->create(	'image',0,0, 
		'-anchor' => 'nw', 
		'-image'  => $img);


$mw->bind('<o>' => sub {
	$scalefactor += $zoomout;
	zoom('out');
});


$mw->bind('<i>' => sub {
	$scalefactor -= $zoomin;
	zoom('in');
});


$mw->bind('<c>' => sub {
	$sf = ($scalefactor > 0) ? $scalefactor : 1;
	my ($originx, $originy, $endpointx, $endpointy, $width, $height) = get_selection_data($sf, @selection_coords);

	print "w:$width h:$height\n";
	my $outfile = $file;
	$outfile =~ s/\.(jpe?g)$//i;
	$outfile = "$outfile-cropped.$1";
	my $cmd = "$cropcommand -copy all -crop ${width}x${height}+${originx}+${originy} -outfile \"$outfile\" \"$file\"";
	print "Cropping...\n\n$cmd\n\n";
	`$cmd`;
	print "Done.\n\n\n";
});


$canv->CanvasBind('<3>' => sub {
	my $x = $canv->canvasx($Tk::event->x);
	my $y = $canv->canvasy($Tk::event->y);
	@selection_coords = ($x, $y, $x, $y);
    
	$selection = $canv->createRectangle(	@selection_coords,
						-outline => 'red',
						-tags => ['RECT'],
						-fill => 'white',
						-stipple => 'transparent'
						) unless $selection_exists;
	$selection_exists = 1;
});


$canv->CanvasBind('<B3-Motion>' => sub {
	@selection_coords[2,3] = ($canv->canvasx($Tk::event->x),
				$canv->canvasy($Tk::event->y));
    
	$canv->coords($selection => @selection_coords);

	print_selection_data();
});


$canv->CanvasBind('<B3-ButtonRelease>' => sub {
	$sf = ($scalefactor > 0) ? $scalefactor : 1;

	print_selection_data();
});


sub zoom($)
{
	my $direction = shift;
	$scalefactor = 0 if $scalefactor < 0;
	$sf = ($scalefactor > 0) ? $scalefactor : 1;

	unless($sf == $lastsf)
	{
		$img->blank(); # clear the old image
		$img->copy($fullsize, -subsample => $sf); # make the new one
		$img->configure(); # display the new one

		$box = [0, 0, $imgwidth/$sf, $imgheight/$sf]; # resize the scrollable area
		#$canv->configure(-scrollregion => $box, -width => $imgwidth/$sf, -height => $imgheight/$sf);
		#$canv->pack(qw/-fill both -expand 1 -anchor nw/);

		print "sf:$sf\n";
		if($direction eq 'out')
		{
			my $selection_sf = $sf < 3 ? 2 : ((0.5*$sf)/((0.5*$sf)-1));
			$_ /= $selection_sf for @selection_coords;
		}
		else
		{
			my $local_sf = $sf + 2;
			my $selection_sf = $local_sf > 3 ? ((0.5*$local_sf)/((0.5*$local_sf)-1)) : 2;
			$_ *= $selection_sf for @selection_coords;
		}

		$canv->coords($selection => @selection_coords);
		$canv->configure(-scrollregion => $box); # apply the change
	}
	$lastsf = $sf;
}


sub swap($$)
{
	my $temp = $_[0];
	$_[0] = $_[1];
	$_[1] = $temp;
}


bindForResize($canv);

MainLoop;

sub bindForResize {
    my $canv = shift;

    my $dx   = 0;
    my $dy   = 0;
    my $mode = 0;    # 0 => move
                     # 1 => resize
    my $pct  = 0.2;
    my $oldx = 0;
    my $oldy = 0;
    my $rect;

    $canv->bind('RECT' => '<1>' =>
                sub {
                    my ($x, $y) = ($Tk::event->x, $Tk::event->y);
                    my $id      = $canv->find(qw/withtag current/);
                    @selection_coords  = $canv->coords($id);

                    my $width   = $selection_coords[2] - $selection_coords[0];
                    my $height  = $selection_coords[3] - $selection_coords[1];

			my $first = $selection_coords[0] + 0.2 * $width;
			my $second = $selection_coords[2] - 0.2 * $width;

                    if      ($x < $first) {
                        $dx = 1;
                    } elsif ($x > $second) {
                        $dx = -1;
                    } else {
                        $dx = 0;
                    }

			#print "x=$x\nfirst=$first\nsecond=$second\n\n";

                    if      ($y < $selection_coords[1] + 0.2 * $height) {
                        $dy = 1;
                    } elsif ($y > $selection_coords[3] - 0.2 * $height) {
                        $dy = -1;
                    } else {
                        $dy = 0;
                    }

                    $mode = ($dx || $dy) ? 1 : 0;
                    $oldx = $x;
                    $oldy = $y;
                    $rect = $id;

                    if ($mode) {
                        $canv->createRectangle(@selection_coords,
                                               -outline => 'green',
                                               -tags    => ['TEMP'],
                                               );
                    }

                    return;
                });

    $canv->bind('RECT' => '<B1-Motion>' =>
                sub {
                    my ($x, $y) = ($Tk::event->x, $Tk::event->y);
                    my $id      = $canv->find(qw/withtag current/);

                    if ($mode) {  # resize
                        @selection_coords = $canv->coords('TEMP');

                        if    ($dx ==  1) { $selection_coords[0] = $x }
                        elsif ($dx == -1) { $selection_coords[2] = $x }

                        if    ($dy ==  1) { $selection_coords[1] = $y }
                        elsif ($dy == -1) { $selection_coords[3] = $y }

                        $canv->coords('TEMP', @selection_coords);
                    } else {      # move
                        $canv->move($id => $x - $oldx, $y - $oldy);
                        $oldx = $x;
                        $oldy = $y;
                    }

		print_selection_data();
                });

    $canv->CanvasBind('<B1-ButtonRelease>' => sub {
	if($mode)
	{
	        @selection_coords = $canv->coords('TEMP');
	}
	else
	{
	        @selection_coords = $canv->coords('RECT');
	}

        # Delete the rectangle.
        $canv->delete('TEMP');

        $canv->coords($rect => @selection_coords);

	print_selection_data();
    });
}


sub get_selection_data()
{
	$sf = ($scalefactor > 0) ? $scalefactor : 1;
	my ($originx, $originy, $endpointx, $endpointy) = @selection_coords;
	$_ *= $sf for($originx, $originy, $endpointx, $endpointy);

	for($originx, $originy, $endpointx, $endpointy)
	{
		$_ = 0 if $_ < 0;
	}

	for($originx, $endpointx)
	{
		$_ = $imgwidth if $_ > $imgwidth;
	}

	for($originy, $endpointy)
	{
		$_ = $imgheight if $_ > $imgheight;
	}

	swap($originx, $endpointx) if $originx > $endpointx;
	swap($originy, $endpointy) if $originy > $endpointy;

	my $width = $endpointx - $originx;
	my $height = $endpointy - $originy;

	return ($originx, $originy, $endpointx, $endpointy, $width, $height);
}


sub print_selection_data()
{
	my ($originx, $originy, $endpointx, $endpointy, $width, $height) = get_selection_data();
	print "($originx, $originy) -> ($endpointx, $endpointy) = $width x $height\n";
}