# See perldoc at end of file for description

use Cwd;
use Math::Trig;

#Change as needed (1.57 works well for the Canon D60).
# Values of 1.0 - 1.6 are generally appropriate for modern DSLRs
# values of 3.0 - 8.0 are typical for point-n-shoot digicams.
$focal_length_multiplier = 1.57;

# Set up some defaults -- change as needed
$imgPathField = 0;
$imgNameField = 1;

# where the files and scripts should be written.
$subDir = "Panorama Components";

# arg1: Directory with images
$dir = shift;

# arg2: Get the command line args
$moveFiles = shift;
if ($moveFiles==1) {$command = "copy";}
elsif ($moveFiles==2) {$command = "move";}
elsif ($moveFiles==3) {$command = "echo";}

# arg3: make a project file or not?
$makePTScript = shift;

# Main program
chdir $dir || die "Cannot change directory to $dir\n";

if (!(-d $subDir) && ($moveFiles==1 || $moveFiles==2))
	{print "Making $subDir\n"; `mkdir \"$subDir\"`;}

opendir (DIR, ".") || die "Couldn't Open Start dir: $dir";
#only JPEG files have EXIF data, so ignore all others
@files = grep /$\.jpg/i, readdir(DIR);
sort (@files);
closedir (DIR);

print "\nProcessing: " . getcwd . "\n\n";

foreach $file (@files)
    {
    my ($match) = 1;
    @lastFields = @fields;
    $ret = `identify -format \"%w|%h|%[EXIF:ExposureTime]|%[EXIF:FNumber]|%[EXIF:FocalLength]|%[EXIF:ISOSpeedRatings]|%[EXIF:ExposureBiasValue]\" \"$file\"`;
    chomp ($ret); chomp ($ret);

	#Skip ahead if no EXIF data in this image
    next if ($ret =~ /\|\|\|/);

	@fields = split(/\|/, $ret);

	#See if all EXIF data in this image is the same as the last image
	for ($i=0; $i<=$#fields; $i++)
	    {
	    if ($fields[$i] ne $lastFields[$i])
		    {
	    	#this line is different from preceding...print a pano script
		    &printPanSequence;
			#reset variables before continuing to next image
		 	$match=0; $numInSequence=1; $firstInSequence = ""; $lastInSequence = "";
		 	@panFiles = ();
			last;
		    }

	    }

	if ($match==1)
		{
	    #this image has same params as preceding...update params and continue
		$numInSequence++;

		if ($firstInSequence eq "")
			{
			$firstInSequence = $lastFile;
			if ($moveFiles==1 || $moveFiles==2) {`$command \"$firstInSequence\" \"$subDir\"`;}
			push (@panFiles, $firstInSequence);
			}

		$lastInSequence = $file;
		if ($moveFiles==1 || $moveFiles==2) {`$command \"$lastInSequence\" \"$subDir\"`;}
		push (@panFiles, $lastInSequence);

		}

	$lastFile = $file;

    }

#Only needed if the last file in a directory is part of a pan sequence
&printPanSequence;
print "\n";

close INFILE;
exit;

#######################################################################
sub printPanSequence
{
	if ($firstInSequence ne "" && $lastInSequence ne "" && $firstInSequence ne $lastInSequence)
		{
		$panCounter++;
		print "\n$panCounter: $firstInSequence - $lastInSequence ($numInSequence files)  ";
		&makePTScriptFile
		}

	return;
}

#######################################################################
sub makePTScriptFile
{

	#don't write a script if no files or explicitly forbidden
	return if ($#panFiles<1 || $makePTScript == 0);

	#Get width and height
	my ($width, $height, $shutter, $aperture, $fLen, $iso, $evBias) = @lastFields;

	#Convert focal length to '35mm equivalent'
	$fLen *= $focal_length_multiplier;
	my ($fov) = 0;
	my ($totFov) = 0;
	my ($panWidth) = 4400;
	my ($panHeight) = 4000;
	my ($panType) = 0;


	$fov = &fov($fLen, $width, $height);

	#small default for 'b' param
	$b = 0.001;
	
	#Try and make an educated guess about pano type/dimensions
	if ($height > $width)		# Portrait...probably long and narrow (e.g. 7x1)
		{
		$totFov = int($fov * ($#panFiles + 1) * 0.96);
		$panHeight = int($height * 1.2);
		$panWidth = $width * ($#panFiles + 1);
		$panType = 1; #Cylindrical projection
		}
	else 						# Probably rectangular (2x2, 3x3, etc)
		{
		$totFov = int($fov * sqrt($#panFiles + 1) * 0.96);
		$panHeight = int($height * sqrt($#panFiles + 1) * 1.2);
		$panWidth = int($width * sqrt($#panFiles + 1) * 1.1);
		$panType = 0; #Rectilinear projection
		}

	$totFov = (int (100 * $totFov))/100;

	@template = &getTemplate;

	#create the name of the script file (in subdirectory if we are moving files)
	my ($outFile) = "";
	$outFile = "$subDir\\" if ($moveFiles);
	my (@temp) = split /\./,$panFiles[0];
	$outFile .= "$temp[0]";
	my (@temp) = split /\./,$panFiles[$#panFiles];
	$outFile .= "-"."$temp[0]".".ptp";

	#Overwrite an existing script?
	#If != 2 then the user did not specify always...
	if (-e $outFile && ($overWrite==0 || $overWrite==1))
		{
		&getOverwriteConfirmation($outFile);

		#Don't over-write script if user doesn't agree
		if ($overWrite < 1)
			{
			print "\n\n";
			return 1;
			}
		}

	if ($overWrite == 3)
		{
		#Don't write script unless there are no existing control points
		open TESTFILE, $outFile or print "\nInfo: $outFile doesn't exist\n\n";
		while (<TESTFILE>)
			{
			if (/^c n[0-9] N[0-9]/)
				{
				print "\nFile exists with control points\n";
				close TESTFILE;
				return 1;
				}
			}
		close TESTFILE;
		}

	#User has agreed to overwrite, or no script file exists
	print "\nWriting Script: $outFile\n";

	open OUTFILE, ">$outFile" or die "Error: Can't write script file: $outFile";

	#write out the script file
	foreach $aLine (@template)
		{
			if ($aLine =~ /<!--images-->/)
			{
				foreach $aFile (@panFiles)
					{
					print OUTFILE "#-imgfile $width $height \"$aFile\"\n";
					print OUTFILE "o f0 y0 p0 r0 v$fov a0 b$b c0 d0 e0 g0 t0\n";
					}
			}
			elsif ($aLine =~ /<!--optimizer-->/)
			{
				#Optimize all except the 0th image
				print OUTFILE "v ";
				for ($i=1; $i<=$#panFiles; $i++)
					{print OUTFILE " y$i r$i p$i";}
				print OUTFILE "\n";
			}
			elsif ($aLine =~ /<!--fov-->/)
			{
				$aLine =~ s/<\!--fov-->/$totFov/g;
				$aLine =~ s/<\!--panHeight-->/$panHeight/g;
				$aLine =~ s/<\!--panWidth-->/$panWidth/g;
				$aLine =~ s/<\!--panType-->/$panType/g;
				print OUTFILE "$aLine\n";
			}
			else
			{
				print OUTFILE "$aLine\n";
			}
		}

	close OUTFILE;

}

#######################################################################
sub getTemplate
{

	my (@template) = ("# PTAssembler project file",
	"",
	"# Panorama Output Settings:",
	"p w<!--panWidth--> h<!--panHeight--> f<!--panType--> v<!--fov--> n\"PSD_nomask\"",
	"",
	"# Source Image File Data:",
	"<!--images-->",
	"",
	"# Optimizer Settings Information:",
	"<!--optimizer-->");

	 return (@template);
 }


#######################################################################
# returns field of view (Assumes focal length is specified in
# "35mm equivalent" values)
sub fov
{
	my ($fLen, $w, $h) = @_;
	my ($filmWidth) = 36;	# Assume landscape orientation
	my ($fov) = 20;			# default in case of error!

	if ($h > $w) {$filmWidth = 24;}

	$fov = 2 * rad2deg(atan($filmWidth/(2 * $fLen)));
	$fov = (int (100 * $fov))/100;

	return $fov;
}

#######################################################################
# Prompts for confirmation to overwrite a file and sets the global
# variable $overWrite to 0 - 3 depending on response.

sub getOverwriteConfirmation
{
	$aFile = @_[0];
	my ($tmp);

	print "\n$aFile already exists.  Overwrite ([Y]es, [N]o, [A]lways, Always unless [C]ontrol Points set)?";
	chomp ($tmp = <STDIN>);
	if ($tmp =~ /^n/i)
		{$overWrite = 0;}
	elsif ($tmp =~ /^y/i)
		{$overWrite = 1;}
	elsif ($tmp =~ /^a/i)
		{$overWrite = 2;}
	elsif ($tmp =~ /^c/i)
		{$overWrite = 3;}
	else
		{
		print "\nAnswer not understood...\n\n";
		&getOverwriteConfirmation($aFile);
		}

}

__END__

=head1 pan.pl

 Author: Max Lyons (maxlyons@tawbaware.com)

 Date: October 2003
 
 Description: This script creates PTAssembler project files for a 
 directory of EXIF/JPEG images.  
 
 Given a directory containing EXIF/JPEG images, this script examines each 
 image to try and determine which images belong to a project.  The script
 examines the EXIF data in the images, looking at focal length, aperture, 
 shutter speed (and other) parameters.  When it finds a sequence of 
 images with identical parameters it assumes that they are part of a 
 project, and (optionally) (copies or) moves the images to a subdirectory, 
 and writes out a PTAssembler project file for the sequence of images.
 
 Note that this is not foolproof.  For example, if you have multiple 
 projects,  all taken with exactly the same parameters this script will 
 assume that it is, instead, one large project.  Similarly, if you use 
 different parameters (e.g. shutter speed), for each image in a project, 
 then this script will failto recognize it as a valid project.  Still, 
 it works pretty well most of the time and can significantly reduce the 
 time needed to cull through a directory of images and determine which 
 images belong to which project.
 
 Requirements: This script requires ImageMagick (www.imagemagick.org) to 
 be installed and available on the system path.
 
 Usage: 
  perl pan.pl [arg1] [arg2] [arg3]

 First arg:
    Directory that contains images (e.g. ".", or "./images")

 Second arg:
    0 = Don't move/copy files
    1 = Copy files to subdir
    2 = Move files to subdir
    3 = Don't copy or move files to subdir, but write script file
        in subdir if script file is requested

 Third arg:
    0 = Don't make a PTAssembler script
    1 = Make a script

 Example usage: A typical call might be:
    perl -S pan.pl . 2 1

    This would examine all files in the current directory ("."), move 
    any files that belong to a panoramic/mosaic sequence to a 
    subdirectory ("2"), and make scripts for each panoranama ("1").

 License: This script is freeware, but provided with no support or 
          warranty. The Author disclaims any and all resposibility for 
          any consequences that result for the use of this script.
          
=cut