|
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 |