bin/ran2tiff.pl
author Axel Jacobs <axel@jaloxa.eu>
Tue, 11 Mar 2014 00:29:36 +0000
changeset 60 448b4b706fa5
parent 8 9ed02f081b72
permissions -rwxr-xr-x
ltpict: minor changes.

#!/usr/bin/perl

# Convert Radiance animation frames to TIFF output
#
# This is a re-write of Greg's ran2tiff.csh
#
# Axel, Oct 2010

use strict;
use warnings;

use File::Basename;

my $histosiz = 200;
my $histof = '';      # Histogram file (-H)
my $fwt = 0.9;        # Frame weight (-W)
my $outdir = '';      # Output directory for TIFFs (-D)
my @pcopts = ();      # Options passed through to pcond
my @tfopts = ();      # Options passed through to ra_tiff

if ($#ARGV < 0) {
	@ARGV = ('DUMMY');
}

# Process options for pcond and ra_tiff
while (@ARGV) {
	$_ = $ARGV[0];
	if (m/-W/) {   # Weight of each frame
		$pfwt = $ARGV[1];
		shift @ARGV;
	} elsif (m/-H/) {   # Histogram file
		$histof = "$ARGV[1]";
		shift @ARGV;
	} elsif (m/-D/) {   # Output directory for TIFFs
		die("$0: Directory $ARGV[1] does not exist.\n")
				unless (-d "$ARGV[1]");
		$outdir = "$argv[1]";
		shift @ARGV;
	} elsif ((m/-h\w+/) or (m/-a\w+/) or   # human, acuity
			(m/-v\w+/) or (m/-s\w+/) or    # veiling glare, contrast sensitiviy
			(m/-c\w+/) or (m/-l\w+/)) {    # mesopic, linear response
		push(@pcopts, $_);
	} elsif ((m/-u/) or (m/-d/) or (m/-f/)) {
		# Lmax of device, dynamic range of device, macbeth.cal file
		push(@pcopts, $_, $ARGV[1]);
		shift @ARGV;
	} elsif (m/-p/) {   # pcond -p (primaries)
		push(@pcopts, '-p');
		for (my $i=0; $i<6, $i++) {
			push(@pcopts, $ARGV[1]);
			shift @ARGV;
		}
	} elsif ((m/-z/) or (m/-b/) or (m/-w/)) {
		# LZW-compression, 8-bit greyscale, 16-bit
		push(@tfopts, $_);
	} elsif (m/-g/) {
		push(@tfopts, '-g', $_);   # Gamma value for ra_tiff
		shift @ARGV;
	} elsif (m/^-/) {
		die("$0: Bad option: $_\n");
	} else {
		last;
	}
	shift @ARGV;
}

die("$0: Need at least two frames.\n") unless ($#ARGV >= 1);
#echo Usage: "$0 [-W prev_frame_wt][-H histo][-D dir][pcond opts][ra_tiff opts] frame1 frame2 .."

my $td = tempdir( CLEANPU => 1 );

# Get shrunken image luminances
foreach (@ARGV) {
	my ($name, undef, undef) = fileparse($_);
	my $datf = "$td/$name.dat";
	my $cmd = "pfilt -1 -x 128 -y 128 -p 1 \"$_\"";
	$cmd .= " |pvalue -o -h -H -b -df";
	$cmd .= " |rcalc -if1 -e 'L=\$1*179;cond=L-1e-7;\$1=log10(L)' > $datf";
	system("$cmd");
}

# Get Min. and Max. log values
my $Lmin = `cat $td/*.dat | total -l | rcalc -e '\$1=\$1-.01'`;
chomp($Lmin);
my $Lmax = `cat $td/*.dat | total -u | rcalc -e '\$1=\$1+.01'`;
chomp($Lmax);

if ($histof) {
	if (-r $histof) then
		# Fix min/max and translate histogram
		set Lmin=`sed -n '1p' $histof | rcalc -e 'min(a,b):if(a-b,b,a);$1=min($1,'"$Lmin)"`
		set Lmax=`sed -n '$p' $histof | rcalc -e 'max(a,b):if(a-b,a,b);$1=max($1,'"$Lmax)"`
		tabfunc -i hfunc < $histof > $td/oldhist.cal
		cnt $histosiz \
			| rcalc -e "L10=$Lmin+($Lmax-$Lmin)/$histosiz"'*($1+.5)' \
				-f $td/oldhist.cal -e '$1=L10;$2=hfunc(L10)' \
			> $td/oldhisto.dat
	endif
}

foreach ($ARGV) {
	#inp = $_
	set datf="$inp:t"
	set datf="$td/$datf:r.dat"
	set outp="$inp:t"
	set outp="$outdir$outp:r.tif"
	endif
	histo $Lmin $Lmax $histosiz < $datf > $td/newhisto.dat
	if (-f $td/oldhisto.dat) then
		rlam $td/newhisto.dat $td/oldhisto.dat \
			| rcalc -e '$1=$1;$2=$2+$4*'$pfwt \
			> $td/histo.dat
	else
		mv $td/{new,}histo.dat
	endif
	pcond $pcopts -I $inp:q < $td/histo.dat \
		| ra_tiff $tfopts - $outp:q
	mv $td/{,old}histo.dat
}

if ($?histof) then
	cp -f $td/oldhisto.dat $histof
endif

#EOF