|
8
|
1 |
#!/usr/bin/perl
|
|
|
2 |
|
|
|
3 |
# Convert Radiance animation frames to TIFF output
|
|
|
4 |
#
|
|
|
5 |
# This is a re-write of Greg's ran2tiff.csh
|
|
|
6 |
#
|
|
|
7 |
# Axel, Oct 2010
|
|
|
8 |
|
|
|
9 |
use strict;
|
|
|
10 |
use warnings;
|
|
|
11 |
|
|
|
12 |
use File::Basename;
|
|
|
13 |
|
|
|
14 |
my $histosiz = 200;
|
|
|
15 |
my $histof = ''; # Histogram file (-H)
|
|
|
16 |
my $fwt = 0.9; # Frame weight (-W)
|
|
|
17 |
my $outdir = ''; # Output directory for TIFFs (-D)
|
|
|
18 |
my @pcopts = (); # Options passed through to pcond
|
|
|
19 |
my @tfopts = (); # Options passed through to ra_tiff
|
|
|
20 |
|
|
|
21 |
if ($#ARGV < 0) {
|
|
|
22 |
@ARGV = ('DUMMY');
|
|
|
23 |
}
|
|
|
24 |
|
|
|
25 |
# Process options for pcond and ra_tiff
|
|
|
26 |
while (@ARGV) {
|
|
|
27 |
$_ = $ARGV[0];
|
|
|
28 |
if (m/-W/) { # Weight of each frame
|
|
|
29 |
$pfwt = $ARGV[1];
|
|
|
30 |
shift @ARGV;
|
|
|
31 |
} elsif (m/-H/) { # Histogram file
|
|
|
32 |
$histof = "$ARGV[1]";
|
|
|
33 |
shift @ARGV;
|
|
|
34 |
} elsif (m/-D/) { # Output directory for TIFFs
|
|
|
35 |
die("$0: Directory $ARGV[1] does not exist.\n")
|
|
|
36 |
unless (-d "$ARGV[1]");
|
|
|
37 |
$outdir = "$argv[1]";
|
|
|
38 |
shift @ARGV;
|
|
|
39 |
} elsif ((m/-h\w+/) or (m/-a\w+/) or # human, acuity
|
|
|
40 |
(m/-v\w+/) or (m/-s\w+/) or # veiling glare, contrast sensitiviy
|
|
|
41 |
(m/-c\w+/) or (m/-l\w+/)) { # mesopic, linear response
|
|
|
42 |
push(@pcopts, $_);
|
|
|
43 |
} elsif ((m/-u/) or (m/-d/) or (m/-f/)) {
|
|
|
44 |
# Lmax of device, dynamic range of device, macbeth.cal file
|
|
|
45 |
push(@pcopts, $_, $ARGV[1]);
|
|
|
46 |
shift @ARGV;
|
|
|
47 |
} elsif (m/-p/) { # pcond -p (primaries)
|
|
|
48 |
push(@pcopts, '-p');
|
|
|
49 |
for (my $i=0; $i<6, $i++) {
|
|
|
50 |
push(@pcopts, $ARGV[1]);
|
|
|
51 |
shift @ARGV;
|
|
|
52 |
}
|
|
|
53 |
} elsif ((m/-z/) or (m/-b/) or (m/-w/)) {
|
|
|
54 |
# LZW-compression, 8-bit greyscale, 16-bit
|
|
|
55 |
push(@tfopts, $_);
|
|
|
56 |
} elsif (m/-g/) {
|
|
|
57 |
push(@tfopts, '-g', $_); # Gamma value for ra_tiff
|
|
|
58 |
shift @ARGV;
|
|
|
59 |
} elsif (m/^-/) {
|
|
|
60 |
die("$0: Bad option: $_\n");
|
|
|
61 |
} else {
|
|
|
62 |
last;
|
|
|
63 |
}
|
|
|
64 |
shift @ARGV;
|
|
|
65 |
}
|
|
|
66 |
|
|
|
67 |
die("$0: Need at least two frames.\n") unless ($#ARGV >= 1);
|
|
|
68 |
#echo Usage: "$0 [-W prev_frame_wt][-H histo][-D dir][pcond opts][ra_tiff opts] frame1 frame2 .."
|
|
|
69 |
|
|
|
70 |
my $td = tempdir( CLEANPU => 1 );
|
|
|
71 |
|
|
|
72 |
# Get shrunken image luminances
|
|
|
73 |
foreach (@ARGV) {
|
|
|
74 |
my ($name, undef, undef) = fileparse($_);
|
|
|
75 |
my $datf = "$td/$name.dat";
|
|
|
76 |
my $cmd = "pfilt -1 -x 128 -y 128 -p 1 \"$_\"";
|
|
|
77 |
$cmd .= " |pvalue -o -h -H -b -df";
|
|
|
78 |
$cmd .= " |rcalc -if1 -e 'L=\$1*179;cond=L-1e-7;\$1=log10(L)' > $datf";
|
|
|
79 |
system("$cmd");
|
|
|
80 |
}
|
|
|
81 |
|
|
|
82 |
# Get Min. and Max. log values
|
|
|
83 |
my $Lmin = `cat $td/*.dat | total -l | rcalc -e '\$1=\$1-.01'`;
|
|
|
84 |
chomp($Lmin);
|
|
|
85 |
my $Lmax = `cat $td/*.dat | total -u | rcalc -e '\$1=\$1+.01'`;
|
|
|
86 |
chomp($Lmax);
|
|
|
87 |
|
|
|
88 |
if ($histof) {
|
|
|
89 |
if (-r $histof) then
|
|
|
90 |
# Fix min/max and translate histogram
|
|
|
91 |
set Lmin=`sed -n '1p' $histof | rcalc -e 'min(a,b):if(a-b,b,a);$1=min($1,'"$Lmin)"`
|
|
|
92 |
set Lmax=`sed -n '$p' $histof | rcalc -e 'max(a,b):if(a-b,a,b);$1=max($1,'"$Lmax)"`
|
|
|
93 |
tabfunc -i hfunc < $histof > $td/oldhist.cal
|
|
|
94 |
cnt $histosiz \
|
|
|
95 |
| rcalc -e "L10=$Lmin+($Lmax-$Lmin)/$histosiz"'*($1+.5)' \
|
|
|
96 |
-f $td/oldhist.cal -e '$1=L10;$2=hfunc(L10)' \
|
|
|
97 |
> $td/oldhisto.dat
|
|
|
98 |
endif
|
|
|
99 |
}
|
|
|
100 |
|
|
|
101 |
foreach ($ARGV) {
|
|
|
102 |
#inp = $_
|
|
|
103 |
set datf="$inp:t"
|
|
|
104 |
set datf="$td/$datf:r.dat"
|
|
|
105 |
set outp="$inp:t"
|
|
|
106 |
set outp="$outdir$outp:r.tif"
|
|
|
107 |
endif
|
|
|
108 |
histo $Lmin $Lmax $histosiz < $datf > $td/newhisto.dat
|
|
|
109 |
if (-f $td/oldhisto.dat) then
|
|
|
110 |
rlam $td/newhisto.dat $td/oldhisto.dat \
|
|
|
111 |
| rcalc -e '$1=$1;$2=$2+$4*'$pfwt \
|
|
|
112 |
> $td/histo.dat
|
|
|
113 |
else
|
|
|
114 |
mv $td/{new,}histo.dat
|
|
|
115 |
endif
|
|
|
116 |
pcond $pcopts -I $inp:q < $td/histo.dat \
|
|
|
117 |
| ra_tiff $tfopts - $outp:q
|
|
|
118 |
mv $td/{,old}histo.dat
|
|
|
119 |
}
|
|
|
120 |
|
|
|
121 |
if ($?histof) then
|
|
|
122 |
cp -f $td/oldhisto.dat $histof
|
|
|
123 |
endif
|
|
|
124 |
|
|
|
125 |
#EOF
|