#!/usr/bin/perl -w
# thumbnailer               doom@kzsu.stanford.edu
#                           Mon Jun  9 14:12:00 2003

=head1 NAME 

thumbnailer

=head1 SYNOPSIS

   cd images
   thumbnailer *.jpg
   # Note: output appears in images/thumbnails

   # Alternate form:
   cd images
   thumbnailer -s 150 -t 0.1 *.jpg
   # first trims image by ten percent, than scales to 150x150

=head1 DESCRIPTION

This script creates thumbnail images of the given image
files.  It puts the output in a "thumbnails" directory,
which will be created in the current directory if it does
not exist already.

Creates square thumbnails, which defaults to a geometry
envelope of 200x200, though this is settable with the -s
option.

=head1 OPTIONS

=over 

=item -s <numeric> - the size of the square thumbnails, defaults to 200.

=item -t <decimal fraction> - will trim the edges of the image by the 
  given fraction, (e.g. 0.10 trims off 10% of the image, before scaling 
  it down), defaults to 0.15.

=back 

=cut

use Image::Magick;
use strict;
use Cwd;

my ($image, $err);
my ($path, $filename, $outdir, $input_file, $output_file);
my (%argy, $size, $geom, $trim_fraction);
my ($height, $width, $new_height, $new_width, $shift_x, $shift_y);
my @filelist;

use Getopt::Std;
getopts("s:t:", \%argy); 

$size = $argy{'s'} || 200;  # quote the 's' to keep cperl happy.
if ($size !~ /[0-9.]/) { 
  warn "The -s param, or output \"size\" should be numeric, e.g. 100 or 200\n";
}

$trim_fraction = $argy{'t'} || 0.15;
if ($trim_fraction > 1) { 
  warn "The -t parameter, or \"trim fraction\" must be a fraction, e.g. 0.1 or 0.2\n";
}
if ($trim_fraction !~ /[0-9.]/) { 
  warn "The -t parameter, or \"trim fraction\" should be numeric, e.g. 0.1 or 0.2\n";
}

@filelist = @ARGV;

foreach $input_file (@filelist){ 

   ( ($path, $filename) = $input_file =~ m{ (.*?) / ([^/]*?) $ }x )
      or ($path, $filename) = (cwd(), $input_file);

   $outdir = "$path/thumbnails";
   if (not (-d $outdir)) { 
      mkdir($outdir);
   }
   
   $output_file = "$outdir/$filename";
   
   $image = Image::Magick->new;
   $err = $image->Read($input_file);
   warn "$err" if "$err";
   
   ($height, $width) = $image->Get('height', 'width');
   
   $new_height = int( $height * (1 - $trim_fraction) );
   $new_width = int( $width * (1 - $trim_fraction) );
   $shift_x = int(($trim_fraction*$width)/2);
   $shift_y = int(($trim_fraction*$height)/2);
   ### $geom = $new_width . 'x' . $new_height;
   $geom = $new_width . 'x' . $new_height . '+' . $shift_x . '+' . $shift_y;
   $err = $image->Crop( geometry=>$geom);
   warn "$err" if "$err";
   
   $geom = $size . 'x' . $size;
   $err = $image->Scale(geometry=>$geom);
   warn "$err" if "$err";
   
   $err = $image->Write($output_file);
   warn "$err" if "$err";
}

__END__

=head1 DISCUSSION

=head2 other ways

This is much like the "convert" command, except that the UI
isn't *totally* insane.

I used to do thumbnails like this:

    ls *.jpg | xargs -i convert -size 200x200 {} -resize 200x200 +profile '*' {}-thumbnail.jpg

=head2 general notes

"Thumbnails" are smaller forms of images that thus load
faster, and are intended to give the reader an idea of what 
an image is, before clicking through to see the "full size" 
version.   Many people seem to take the phrase too seriously, 
and generate "thumbnails" that are literally the size of your 
thumbnail and which are next to useless.  This is why I've got 
the default set relatively large at 200 pixels wide. Similarly, 
I really like the trick of cropping the image slightly in addition 
to scaling it down: the focus of the image is likely to be near 
the center, so you're more likely to get a recognizable thumbnail.

Forcing the thumbnails to be square is a compromise that
makes the layout of an index to the series of images much
easier.  

=head1 AUTHOR

Joseph Brenner, E<lt>doom@kzsu.stanford.eduE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2004 by Joseph Brenner

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
at your option, any later version of Perl 5 you may have available.

=head1 BUGS

None reported... yet.

=cut