Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

See my attempt below at a "semi-gui" jpeg lossless cropping utility. The idea is to cycle through a few jpeg files, set the crop parameters by moving sliders with cursor keys, and crop the jpegs losslessly. A little background: I have a bunch of jpegs that are produced by a camera shooting old slides (a cheap and dirty slide scanner). They all have black borders due to the copying setup. What I aim is to check that the crop parameters are correct on each picture. Lossless means cropping along multiple of 8 pixels using appropriate outside utilities (namely jpegtran). Anyway, my program works, but I find it a bit too much "Mc Gyver"-like. In particular, I go back and forth between perlmagick and gtk2 to draw the cropping rectangle and the picture, which slows everything down, not to the point of being unusable, but still, rather ugly. If anybody sees a better way to do it (a canvas, goo, or whatnot), feel free to help me! Guillaume

#!/usr/bin/perl -w use Glib qw/TRUE FALSE/; use Gtk2 '-init'; use File::Find; use File::Basename; use Image::Magick; use Image::Size; use POSIX; @files = @ARGV; $bord = 8 ; $overall_scale = 2; $count_files = 0; read_file(); auto_crop(); $mw = Gtk2::Window->new; $mw->set_size_request( $width / $overall_scale + 8, $height / $overall_scale + 8 ); $vbox = Gtk2::VBox->new( FALSE, 1 ); $vp = Gtk2::Viewport->new( undef, undef ); $sw = Gtk2::ScrolledWindow->new( undef, undef ); $sw->set_policy( 'never', 'never' ); $sw->add($vp); &load_image(); $vbox->pack_start( $sw, 1, 1, 1 ); $mw->add($vbox); $mw->show_all(); $mw->signal_connect( 'destroy', sub { Gtk2->main_quit } ); $mw->signal_connect( 'key-press-event' => \&proc_key ); Gtk2->main; sub new_rect { $ax = $dx / $overall_scale; $ay = $dy / $overall_scale; $bx = $nx / $overall_scale; $by = $ny / $overall_scale; undef @$imagemagick; $imagemagick = Image::Magick->new( size => "$geo_x" . "x$geo_y" ); $imagemagick->BlobToImage($background); $imagemagick->Draw( stroke => 'red', filled => 'true', primitive => 'line', points => "$ax,$ay $bx,$ay" ); $imagemagick->Draw( stroke => 'red', filled => 'true', primitive => 'line', points => "$ax,$by $bx,$by" ); $imagemagick->Draw( stroke => 'red', filled => 'true', primitive => 'line', points => "$ax,$ay $ax,$by" ); $imagemagick->Draw( stroke => 'red', filled => 'true', primitive => 'line', points => "$bx,$ay $bx,$by" ); $rect_blob = $imagemagick->ImageToBlob(); } sub load_image { new_rect(); $loader = Gtk2::Gdk::PixbufLoader->new; $loader->write($rect_blob); $loader->close; $pixbufrect = $loader->get_pixbuf; $image = Gtk2::Image->new_from_pixbuf($pixbufrect); $vp->add($image); $mw->show_all(); } sub clamp { if ( $ny > $height ) { $ny = $height; } if ( $nx > $width ) { $nx = $width; } if ( $dy < 0 ) { $dx = 0; } if ( $dy < 0 ) { $dy = 0; } } ##################################################### sub proc_key { my ( $widget, $event, $parameter ) = @_; my $key_val = $event->keyval(); print "$key_val, $dx, $dy, $nx, $ny\n"; # key=1=top left corner adjustment if ( $key_val == 49 ) { $dlb = 8; $drb = 0; $dtb = -8; $dbb = 0; } # key=2=top right corner adjustment if ( $key_val == 50 ) { $dlb = 0; $drb = 8; $dtb = -8; $dbb = 0; } # key=3=bottom right corner adjustment if ( $key_val == 51 ) { $dlb = 0; $drb = 8; $dtb = 0; $dbb = -8; } # key=4=bottom left corner adjustment if ( $key_val == 52 ) { $dlb = 8; $drb = 0; $dtb = 0; $dbb = -8; } #right arrow moves lines to the right (how original) if ( $key_val == 65363 ) { $dx += $dlb; $nx += $drb; clamp(); $image->clear; $vp->remove($image); &load_image(); return TRUE; } #up arrow moves lines up (how original) if ( $key_val == 65362 ) { $dy += $dtb; $ny += $dbb; clamp(); $image->clear; $vp->remove($image); &load_image(); return TRUE; } #down arrow moves lines down (how original) if ( $key_val == 65364 ) { $dy += -$dtb; $ny += -$dbb; clamp(); $image->clear; $vp->remove($image); &load_image(); return TRUE; } #left arrow moves lines to the left (how original) if ( $key_val == 65361 ) { $dx += -$dlb; $nx += -$drb; clamp(); $image->clear; $vp->remove($image); &load_image(); return TRUE; } # key=n cycle to next picture given as argument if ( $key_val == 110 ) { read_file(); $image->clear; $vp->remove($image); &load_image(); return TRUE; } # key=c does the actual lossless cropping using jpegtran if ( $key_val == 99 ) { $newwidth = $nx - $dx; $newheight = $ny - $dy; $crop = "$newwidth" . "x$newheight+$dx+$dy"; $newfile = $file; $newfile =~ s/\.jpg/-crop\.jpg/; if ( -e "$newfile" ) { system("rm $newfile"); } $error = `jpegtran -perfect -copy all -crop $crop $file > $new +file`; print "$error\n"; } # catch Esc or q to exit if ( ( $key_val == 113 ) || ( $key_val == 65307 ) ) { &delete_even +t } #good practice to let the event propagate, should we need it somew +here else return FALSE; } sub read_file { undef $imagemagick; $imagemagick = Image::Magick->new; $file = $files[$count_files]; $error = $imagemagick->Read("$file"); warn "$$error" if "$error"; ( $width, $height ) = Image::Size::imgsize("$file"); $geo_x = floor( $width / $overall_scale ); $geo_y = floor( $height / $overall_scale ); $imagemagick->Scale( "$geo_x" . "x$geo_y" ); $background = $imagemagick->ImageToBlob(); $count_files++; if ( $count_files > $#files ) { $count_files = 0; } } sub auto_crop { $color = `convert $file -format "%[pixel:s.p{0,0}]" info:`; $color =~ s/\(/\\\(/; $color =~ s/\)/\\\)/; chomp($color); $crops = `convert $file -fuzz 50\% -trim -bordercolor $color -border $bord info +\:-`; print "$crops\n"; # on my system, the "crop parameters" are wrong: e.g. + # # # # pict7260.jpg JPEG 2911x1846 3024x2016+11+170 8-bit DirectClass 2 +.598mb # # # # instead of # # # # pict7260.jpg JPEG 3024x2016 2911x1846+11+170 8-bit DirectClass +2.598mb# $dw = $width + $bord * 2; $dh = $height + $bord * 2; $area = "$dw" . "x$dh"; $crops =~ s/ $area//; $crops = ( split( / /, $crops ) )[2]; ( $cw, $ch ) = split( /x/, $crops ); ( $ch, $dx, $dy ) = split( /\+/, $ch ); $dx = ( ceil( $dx / 8 ) + 1 ) * 8; $dy = ( ceil( $dy / 8 ) + 1 ) * 8; $cw = ( floor( $cw / 8 ) - 1 ) * 8; $ch = ( floor( $ch / 8 ) - 1 ) * 8; $nx = $dx + $cw; $ny = $dy + $ch; clamp(); } ##################################### sub delete_event { Gtk2->main_quit; return FALSE; }

Replies are listed 'Best First'.
Re: semi-gui jpeg cropping
by gvb (Novice) on Nov 06, 2009 at 16:06 UTC
    Just commenting on my own post now that I finally got the password :-)
    What I meant to ask is how to redisplay/update only the part of the image where the crop rectangle has actually moved, without redrawing the whole image. This should speed up things considerably.