hdrprep-0.1.2.pl
#!/usr/bin/perl -w
# hdrprep: register exposure-bracketed digicam images
# Copyright (C) 2006 Axel Jacobs
#
# Version: 0.1.2, 11 Mar 2007
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor,
# Boston, MA 02110-1301, USA.
require 5.001;
use strict;
# Prerequisites
use Image::Magick;
use Getopt::Long;
use Image::ExifTool;
# What are we doing?
my $ALIGN;
my $REDO;
my $EXIF;
my $HELP;
# Variables that may we overwritten by command-line args
# are all in CAPITALS.
my $VERBOSE;
my $DIR = "aligned";
my $QUAL = "80";
my $MC = "10";
my $KEEP;
my $transFile;
sub init
{
# Process command line arguments
Getopt::Long::Configure ('bundling');
GetOptions ("q|quality=i" => \$QUAL,
"m|mc=i" => \$MC,
"d|directory=s" => \$DIR,
"v|verbose" => \$VERBOSE,
"r|redo" => \$REDO,
"a|align" => \$ALIGN,
"k|keep" => \$KEEP,
"e|exif" => \$EXIF,
"h|help" => \$HELP );
$HELP && usage();
if (! ($ALIGN || $REDO || $EXIF)) {
print STDERR "Error: Tell me what to do [-a|-r] [-e].\n";
hint();
}
$transFile = "$DIR/ale_align.trans";
my @imgs;
if ($ARGV[0]) {;
foreach (@ARGV) {
if (! -e $_) {
print STDERR "Error: File $_ doesn't exists.\n";
hint();
}
push @imgs, $_;
}
} else {
print STDERR "Error: Please supply at least two JPG files.\n";
hint();
}
if (! -e $DIR) {
if ($REDO) {
print STDERR "Error: You need to run me with -a first.\n";
hint();
} else {
print "Creating directory $DIR.\n";
mkdir $DIR, 0700 or
die ("Can\'t create directory $DIR: $!\n");
}
}
my $allJpegs = join(', ', @imgs);
print "Processing files: $allJpegs.\n";
($ALIGN || $REDO) &&
print "Setting quality of aligned images to $QUAL.\n";
($ALIGN) &&
print "Will sample $MC % of all pixels for alignment.\n";
print "Using directory $DIR to store new images.\n";
return @imgs;
}
sub hint
{
print "Type hdrprep -h or --help for usage instructions.\n";
exit;
}
sub usage
{
print STDERR < $b} keys %exposure) {
my $keyRnd = sprintf "%.2f", $key;
$VERBOSE && print "$jpgs[$exposure{$key}]: $keyRnd EV\n";
push @imgs, $jpgs[$exposure{$key}];
}
return @imgs;
}
sub runALE
{
my @imgs = @_;
# Align images in pairs of descending exposure
my $aleOpts = "--translation --mc $MC --exp-extend --ips 0 --no-inc";
for ( my $i=0 ; $i<$#imgs ; $i++ ) {
my $outFile = "$DIR/ale_out" . $i . ".jpg";
`ale $aleOpts --trans-save=$transFile$i $imgs[$i] $imgs[$i + 1] $outFile`;
unlink $outFile unless $KEEP;
}
}
sub getExifTags
{
my $tmpFile = shift;
# Print the info necessary to determine the exposure
# from the EXIF header
my $exifTool = new Image::ExifTool;
my $exifData = $exifTool->ImageInfo($tmpFile);
return $exifData;
}
sub getShutter
{
my $exifTags = shift;
my $shutterSpeed;
if ($$exifTags{ExposureTime} or $$exifTags{ShutterSpeed}) {
$shutterSpeed = $$exifTags{ExposureTime} or
$shutterSpeed = $$exifTags{ShutterSpeed};
$shutterSpeed =~ m/(\d+)([\.\/])?(\d+)?/;
$shutterSpeed = $1;
if (defined $3) {
my $tmp = $3;
if ($2 =~ m/\//) {
# e.g. 6/10
$shutterSpeed = $shutterSpeed / $tmp;
} else {
# e.g 0.6
$shutterSpeed = $shutterSpeed . '.' . $tmp;
}
}
$shutterSpeed = sprintf "%.5f", $shutterSpeed;
} else {
$shutterSpeed = 0;
}
return $shutterSpeed;
}
sub getAperture
{
my $exifTags = shift;
my $aperture;
if ($$exifTags{FNumber} or $$exifTags{ApertureValue}) {
$aperture = $$exifTags{FNumber} or
$aperture = $$exifTags{ApertureValue};
$aperture =~ m/(\d+)\.(\d+)?/;
$aperture = $1;
if (defined $2) {
$aperture = $aperture . '.' . $2;
}
} else {
$aperture = 0;
}
return $aperture;
}
sub getFilmSpeed
{
my $exifTags = shift;
my $filmSpeed;
if ($$exifTags{ISO} or $$exifTags{CCDISOSensitivity}) {
$filmSpeed = $$exifTags{ISO} or
$filmSpeed = $$exifTags{CCDISOSensitivity};
$filmSpeed =~ m/(\d+)/;
$filmSpeed = $1;
} else {
$filmSpeed = 0;
}
return $filmSpeed;
}
sub doExposure
{
my $shutterSpeed = shift;
my $aperture = shift;
my $filmSpeed = shift;
my $exposure;
# Exposure = f(Shutter_speed, Aperture, ISO speed):
# EV = log2(aperture2 x (1/shutter speed) x (ISO sensitivity/100))
# log base2 (x) = log (x) / log (2)
if ($shutterSpeed > 0) {
$exposure = log( $aperture*$aperture / $shutterSpeed * $filmSpeed/100) / log(2);
} else {
$exposure = 0;
}
return $exposure;
}
sub copyFiles
{
# If neither -a nor -r, but only -e was requested, copy the original files
# to the new directory for fixing the EXIF info.
use File::Copy;
my @imgs = @_;
for (my $i=0 ; $i<=$#imgs ; $i++) {
if (! -e "$DIR/$imgs[$i]") {
copy("$imgs[$i]", "$DIR/$imgs[$i]");
}
}
}
sub fixEXIF
{
# Correct exposure information of the new images
# We don't need to check for correctness again.
my @imgs = @_;
for (my $i=0 ; $i<=$#imgs ; $i++) {
my $exifData = getExifTags ($imgs[$i]);
my $shutterSpeed = getShutter ($exifData);
my $aperture = getAperture ($exifData);
my $isoSpeed;
$isoSpeed = getFilmSpeed ($exifData) or $isoSpeed = 100;
$VERBOSE && printf "%s: %.4fs, F%.1f, ISO%d\n",
$imgs[$i], $shutterSpeed, $aperture, $isoSpeed;
my $newExif = new Image::ExifTool;
$newExif->SetNewValue(ISO => $isoSpeed);
$newExif->SetNewValue(FNumber => $aperture);
$newExif->SetNewValue(ExposureTime => $shutterSpeed);
$newExif->WriteInfo("$DIR/$imgs[$i]");
}
}
MAIN:
{
my @jpegs = init();
my @images = sortByExposure( @jpegs );
# Only fix the exposure info, don't register images
if ($EXIF && !$ALIGN && !$REDO) {
copyFiles (@images);
fixEXIF (@images);
exit;
}
$ALIGN && runALE( @images );
my @xShiftRel;
my @yShiftRel;
for ( my $i=0 ; $i<$#images ; $i++ ) {
open(TRANS_FH, "<$transFile$i") or
die ("Can\'t open $transFile$i: $!\n");
# Read the x and y offset from the ALE trans file
while () {
next unless m/^E/;
# E x-dim y-dim x-shift y-shift rotation
m/^E(\s-?\d*\.\d*){2}\s(-?\d*\.\d*)\s(-?\d*\.\d*)\s-?\d*\.\d*/;
push @xShiftRel, sprintf "%.3f", $2;
push @yShiftRel, sprintf "%.3f", $3;
}
close(TRANS_FH);
}
$VERBOSE && print "xShiftRelative: " . join(', ', @xShiftRel) . "\n";
$VERBOSE && print "yShiftRelative: " . join(', ', @yShiftRel) . "\n";
my @xShift;
my @yShift;
# The translation is done with reference to the first image.
# x,y shift for image $i is sum of x,y shift for all previous images.
for ( my $i=0 ; $i<$#images ; $i++ ) {
$xShift[$i] = 0;
for ( my $j=0 ; $j<=$i ; $j++ ) {
$xShift[$i] += $xShiftRel[$j];
}
$xShift[$i] = sprintf "%+d", $xShift[$i];
$yShift[$i] = 0;
for ( my $j=0 ; $j<=$i ; $j++ ) {
$yShift[$i] += $yShiftRel[$j];
}
$yShift[$i] = sprintf "%+d", $yShift[$i];
}
$VERBOSE && print "xShift : " . join(', ', @xShift) . "\n";
$VERBOSE && print "yShift : " . join(', ', @yShift) . "\n";
my @xSorted = sort {$a <=> $b} @xShift;
my @ySorted = sort {$a <=> $b} @yShift;
my $xMin = $xSorted[0];
my $xMax = $xSorted[$#xSorted];
my $yMin = $ySorted[0];
my $yMax = $ySorted[$#ySorted];
$VERBOSE && print "xMin: $xMin, xMax: $xMax, " .
"yMin: $yMin, yMax: $yMax\n";
# Get width and height of the original images
my $img = Image::Magick->new(magick=>'JPEG');
my $err = $img->Read("$images[0]");
my($height, $width) = $img->Get('rows', 'columns');
$VERBOSE && print "Old dimensions: $width x $height\n";
# Determine width and height of the new images
my $xNew;
if ($xMax>0 && $xMin>=0) {
$xNew = $width - $xMax;
} elsif ($xMax>0 && $xMin<0) {
$xNew = $width - $xMax + $xMin;
} else {
$xNew = $width + $xMin
}
my $yNew;
if ($yMax>0 && $yMin>=0) {
$yNew = $height - $yMax;
} elsif ($yMax>0 && $yMin<0) {
$yNew = $height - $yMax + $yMin;
} else {
$yNew = $height + $yMin
}
$VERBOSE && print "New dimensions: $xNew x $yNew\n";
# Crop the first (reference) image
$img = Image::Magick->new(magick=>'JPEG');
$err = $img->Read("$images[0]");
my $xShift1st = $xMax<0 ? 0 : $xMax;
my $yShift1st = $yMax<0 ? 0 : $yMax;
my $ale = $img->Copy;
$ale ->Crop(width => $xNew, height => $yNew,
x => $xShift1st, y => $yShift1st);
$ale ->Set(quality => $QUAL);
$ale ->Write("$DIR/$images[0]");
# Crop all remaining images
for (my $i=1 ; $i<=$#images ; $i++) {
$img = Image::Magick->new(magick=>'JPEG');
$err = $img->Read("$images[$i]");
$ale = $img->Copy;
my $x = $xMax - $xShift[$i-1];
my $y = $yMax - $yShift[$i-1];
$x = $xMax<0 ? $x-$xMax : $x;
$y = $yMax<0 ? $y-$yMax : $y;
$ale ->Crop(width => $xNew, height => $yNew, x => $x, y => $y);
$ale ->Set(quality => $QUAL);
$ale ->Write("$DIR/$images[$i]");
}
$EXIF && fixEXIF( @images );
} # MAIN
#EOF