Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:
#!/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 |