• Home
• 
• Resources
• 
• HDR
• 
• hdrprep
• 
• README
• Introduction
• How it works
• Benchmark
• Usage
• Tutorial
• Code
• man Page
• ChangeLog

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