• Home
• 
• Resources
• 
• HDR
• 
• hdrexpo
• 
• Introduction
• Code

hdrexpo-0.1.1.pl

#!/usr/bin/env perl

# File:        hdrexpo.pl
# Description: Adjust the exposure information in a Radiance RGBE HDR
#              image by the given calibration factor.
# Author:      Axel Jacobs
# Version:     0.1.1
# Date:        3 Nov 2008
#
# License:
# 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 3 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, see .

require 5.001;

use warnings;
use strict;

#######################################################################
# Declaration of sub-routines.
#######################################################################

# This is displayed if anything goes wrong.
sub usage() {
	print STDERR "Usage: hdrexp.pl factor hdrfile\n";
	exit(1);
} #usage

sub apply_exposure() {
	my $calibration = shift;
	my $infile = shift;
	# Apply the exposure correction for luminance calibration
	open (INFH, "<$infile") or
			die ("Can't open HDR file $infile: $!\n");
	open (OUTFH, ">-") or
			die ("Can't open STDOUT: $!\n");

	my $line;
	# Read the first few lines of the image until EXPOSURE is found
	while() {
		$line = $_;
		last if /EXPOSURE/;
		print OUTFH $line;
	}
	$line =~ m/^EXPOSURE=(\d+\.\d+e[-+ ]\d\d)$/;
	my $expo = $1;
	# Divided image exposure by calibration factor
	my $exposure = $expo / $calibration;
	printf OUTFH "EXPOSURE=%.6e\n", $exposure;

	# Copy the rest of the file across
	binmode INFH;
	binmode OUTFH;
	my $buffer;
	while (
		read (INFH, $buffer, 65536)	# read in (up to) 64k chunks, write
		and print OUTFH $buffer	# exit if read or write fails
	  ) {};

	close INFH;
	close OUTFH;
} #apply_exposure

#######################################################################
# Main part. This is where the fun starts...
#######################################################################

# Get calibration factor and file name.
my $fact = $ARGV[0] or usage();
my $file = $ARGV[1] or usage();

# Test if the first argument is a positive floating-point number.
my $factor;
if ($fact =~ /^(\d*\.?\d*)$/) {
	$factor = $1;
} else {
	print "Invalid calibration factor: $fact\n";
	exit(1);
}
# Test if the second argument is an existing file.
if (! -f $file) {
	print "Can't find HDR file: $file\n";
	exit(1);
}

&apply_exposure($factor, $file)

#######################################################################
# ChangeLog
# ---------
#
# 0.1,   04 Aug 2008: Initial version created from WebHDR engine
#                     on request of Kyle
# 0.1.1, 03 Nov 2008: Changed output to STDOUT
#######################################################################

#EOF