#!/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('' => sub { $scalefactor += $zoomout; zoom('out'); }); $mw->bind('' => sub { $scalefactor -= $zoomin; zoom('in'); }); $mw->bind('' => 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('' => 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('' => 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' => '' => 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('' => 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"; }