| 9 |  | my $windoz = ($^O eq "MSWin32" or $^O eq "MSWin64"); | 
| 10 |  | use File::Temp qw/ :mktemp  /; | 
| 11 |  | sub userror { | 
| 12 | < | print STDERR "Usage: genBSDF [-n Nproc][-c Nsamp][-W][-t{3|4} Nlog2][-r \"ropts\"][-f \"x=string;y=string\"][-dim xmin xmax ymin ymax zmin zmax][{+|-}C][{+|-}f][{+|-}b][{+|-}mgf][{+|-}geom units] [input ..]\n"; | 
| 12 | > | print STDERR "Usage: genBSDF [-n Nproc][-c Nsamp][-W][-t{3|4} Nlog2][-r \"ropts\"][-s \"x=string;y=string\"][-dim xmin xmax ymin ymax zmin zmax][{+|-}C][{+|-}f][{+|-}b][{+|-}mgf][{+|-}geom units] [input ..]\n"; | 
| 13 |  | exit 1; | 
| 14 |  | } | 
| 15 |  | my ($td,$radscn,$mgfscn,$octree,$fsender,$bsender,$receivers,$facedat,$behinddat,$rmtmp); | 
| 16 | < | my ($tf,$rf,$tb,$rb,$tfx,$rfx,$tbx,$rbx,$tfz,$rfz,$tbz,$rbz); | 
| 17 | < | if ($windoz) { | 
| 16 | > | my ($tf,$rf,$tb,$rb,$tfx,$rfx,$tbx,$rbx,$tfz,$rfz,$tbz,$rbz,$cph); | 
| 17 | > | my ($curphase, $recovery); | 
| 18 | > | if ($#ARGV == 1 && "$ARGV[0]" =~ /^-rec/) { | 
| 19 | > | $td = $ARGV[1]; | 
| 20 | > | open(MYAVH, "< $td/savedARGV.txt") or die "$td: invalid path\n"; | 
| 21 | > | @ARGV = <MYAVH>; | 
| 22 | > | close MYAVH; | 
| 23 | > | chomp @ARGV; | 
| 24 | > | if (open(MYPH, "< $td/phase.txt")) { | 
| 25 | > | while (<MYPH>) { | 
| 26 | > | chomp($recovery = $_); | 
| 27 | > | } | 
| 28 | > | close MYPH; | 
| 29 | > | } | 
| 30 | > | } elsif ($windoz) { | 
| 31 |  | my $tmploc = `echo \%TMP\%`; | 
| 32 | < | chomp($tmploc); | 
| 32 | > | chomp $tmploc; | 
| 33 |  | $td = mkdtemp("$tmploc\\genBSDF.XXXXXX"); | 
| 34 | + | } else { | 
| 35 | + | $td = mkdtemp("/tmp/genBSDF.XXXXXX"); | 
| 36 | + | chomp $td; | 
| 37 | + | } | 
| 38 | + | if ($windoz) { | 
| 39 |  | $radscn = "$td\\device.rad"; | 
| 40 |  | $mgfscn = "$td\\device.mgf"; | 
| 41 |  | $octree = "$td\\device.oct"; | 
| 56 |  | $rfz = "$td\\rfz.dat"; | 
| 57 |  | $tbz = "$td\\tbz.dat"; | 
| 58 |  | $rbz = "$td\\rbz.dat"; | 
| 59 | < | chomp $td; | 
| 60 | < | $rmtmp = "rmdir /S /Q $td"; | 
| 59 | > | $cph = "$td\\phase.txt"; | 
| 60 | > | $rmtmp = "rd /S /Q $td"; | 
| 61 |  | } else { | 
| 44 | – | $td = mkdtemp("/tmp/genBSDF.XXXXXX"); | 
| 45 | – | chomp $td; | 
| 62 |  | $radscn = "$td/device.rad"; | 
| 63 |  | $mgfscn = "$td/device.mgf"; | 
| 64 |  | $octree = "$td/device.oct"; | 
| 79 |  | $rfz = "$td/rfz.dat"; | 
| 80 |  | $tbz = "$td/tbz.dat"; | 
| 81 |  | $rbz = "$td/rbz.dat"; | 
| 82 | + | $cph = "$td/phase.txt"; | 
| 83 |  | $rmtmp = "rm -rf $td"; | 
| 84 |  | } | 
| 85 |  | my @savedARGV = @ARGV; | 
| 86 | < | my $rfluxmtx = "rfluxmtx -v -ab 5 -ad 700 -lw 3e-6"; | 
| 86 | > | my $rfluxmtx = "rfluxmtx -ab 5 -ad 700 -lw 3e-6"; | 
| 87 |  | my $wrapper = "wrapBSDF"; | 
| 88 |  | my $tensortree = 0; | 
| 89 |  | my $ttlog2 = 4; | 
| 121 |  | } elsif ("$ARGV[0]" eq "-t") { | 
| 122 |  | # Use value < 0 for rttree_reduce bypass | 
| 123 |  | $pctcull = $ARGV[1]; | 
| 124 | + | if ($pctcull >= 100) { | 
| 125 | + | die "Illegal -t culling percentage, must be < 100\n"; | 
| 126 | + | } | 
| 127 |  | shift @ARGV; | 
| 128 |  | } elsif ("$ARGV[0]" =~ /^-t[34]$/) { | 
| 129 |  | $tensortree = substr($ARGV[0], 2, 1); | 
| 130 |  | $ttlog2 = $ARGV[1]; | 
| 131 |  | shift @ARGV; | 
| 132 | < | } elsif ("$ARGV[0]" eq "-f") { | 
| 132 | > | } elsif ("$ARGV[0]" eq "-s") { | 
| 133 |  | $wrapper .= " -f \"$ARGV[1]\""; | 
| 134 |  | shift @ARGV; | 
| 135 |  | } elsif ("$ARGV[0]" eq "-W") { | 
| 153 |  | } | 
| 154 |  | # Check that we're actually being asked to do something | 
| 155 |  | die "Must have at least one of +forward or +backward\n" if (!$doforw && !$doback); | 
| 136 | – | # Issue warning for unhandled reciprocity case | 
| 137 | – | print STDERR "Warning: recommend both +forward and +backward with -t3\n" if | 
| 138 | – | ($tensortree==3 && !($doforw && $doback)); | 
| 156 |  | $wrapper .= $tensortree ? " -a t$tensortree" : " -a kf -c"; | 
| 157 |  | $wrapper .= " -u $gunit"; | 
| 158 | < | # Get scene description and dimensions | 
| 159 | < | if ( $mgfin ) { | 
| 160 | < | system "mgf2rad @ARGV > $radscn"; | 
| 161 | < | die "Could not load MGF input\n" if ( $? ); | 
| 162 | < | } else { | 
| 146 | < | system "xform -e @ARGV > $radscn"; | 
| 147 | < | die "Could not load Radiance input\n" if ( $? ); | 
| 148 | < | } | 
| 149 | < | if ($#dim != 5) { | 
| 150 | < | @dim = split ' ', `getbbox -h $radscn`; | 
| 151 | < | } | 
| 152 | < | print STDERR "Warning: Device extends into room\n" if ($dim[5] > 1e-5); | 
| 153 | < | $wrapper .= ' -f "t=' . ($dim[5] - $dim[4]) . ';w=' . ($dim[1] - $dim[0]) . | 
| 154 | < | ';h=' . ($dim[3] - $dim[2]) . '"'; | 
| 155 | < | # Generate octree | 
| 156 | < | system "oconv -w $radscn > $octree"; | 
| 157 | < | die "Could not compile scene\n" if ( $? ); | 
| 158 | < | # Add MGF description if requested | 
| 159 | < | if ( $geout ) { | 
| 160 | < | open(MGFSCN, "> $mgfscn"); | 
| 161 | < | printf MGFSCN "xf -t %.6f %.6f 0\n", -($dim[0]+$dim[1])/2, -($dim[2]+$dim[3])/2; | 
| 162 | < | close MGFSCN; | 
| 158 | > | if ( !defined $recovery ) { | 
| 159 | > | # Issue warning for unhandled reciprocity case | 
| 160 | > | print STDERR "Warning: recommend both +forward and +backward with -t3\n" if | 
| 161 | > | ($tensortree==3 && !($doforw && $doback)); | 
| 162 | > | # Get scene description | 
| 163 |  | if ( $mgfin ) { | 
| 164 | < | system qq{mgfilt "#,o,xf,c,cxy,cspec,cmix,m,sides,rd,td,rs,ts,ir,v,p,n,f,fh,sph,cyl,cone,prism,ring,torus" @ARGV >> $mgfscn}; | 
| 164 | > | system "mgf2rad @ARGV > $radscn"; | 
| 165 | > | die "Could not load MGF input\n" if ( $? ); | 
| 166 |  | } else { | 
| 167 | < | system "rad2mgf $radscn >> $mgfscn"; | 
| 167 | > | system "xform -e @ARGV > $radscn"; | 
| 168 | > | die "Could not load Radiance input\n" if ( $? ); | 
| 169 |  | } | 
| 168 | – | open(MGFSCN, ">> $mgfscn"); | 
| 169 | – | print MGFSCN "xf\n"; | 
| 170 | – | close MGFSCN; | 
| 171 | – | $wrapper .= " -g $mgfscn"; | 
| 170 |  | } | 
| 171 | < | # Create receiver & sender surfaces (rectangular) | 
| 171 | > | if ( $#dim != 5 ) { | 
| 172 | > | @dim = split ' ', `getbbox -h $radscn`; | 
| 173 | > | } | 
| 174 | > | die "Device entirely inside room!\n" if ( $dim[4] >= 0 ); | 
| 175 | > | if ( $dim[5] > 1e-5 ) { | 
| 176 | > | print STDERR "Warning: Device extends into room\n"; | 
| 177 | > | } elsif ( $dim[5]*$dim[5] > .01*($dim[1]-$dim[0])*($dim[3]-$dim[2]) ) { | 
| 178 | > | print STDERR "Warning: Device far behind Z==0 plane\n"; | 
| 179 | > | } | 
| 180 | > | # Assume Zmax==0 to derive thickness so pkgBSDF will work | 
| 181 | > | $wrapper .= ' -f "t=' . (-$dim[4]) . ';w=' . ($dim[1] - $dim[0]) . | 
| 182 | > | ';h=' . ($dim[3] - $dim[2]) . '"'; | 
| 183 | > | $wrapper .= " -g $mgfscn" if ( $geout ); | 
| 184 | > | # Calculate CIE (u',v') from Radiance RGB: | 
| 185 | > | my $CIEuv =     'Xi=.5141*Ri+.3239*Gi+.1620*Bi;' . | 
| 186 | > | 'Yi=.2651*Ri+.6701*Gi+.0648*Bi;' . | 
| 187 | > | 'Zi=.0241*Ri+.1229*Gi+.8530*Bi;' . | 
| 188 | > | 'den=Xi+15*Yi+3*Zi;' . | 
| 189 | > | 'uprime=4*Xi/den;vprime=9*Yi/den;' ; | 
| 190 | > | my $FEPS = 1e-5; | 
| 191 | > | my $ns = 2**$ttlog2; | 
| 192 |  | my $nx = int(sqrt($nsamp*($dim[1]-$dim[0])/($dim[3]-$dim[2])) + 1); | 
| 193 |  | my $ny = int($nsamp/$nx + 1); | 
| 194 |  | $nsamp = $nx * $ny; | 
| 177 | – | my $ns = 2**$ttlog2; | 
| 178 | – | open(RADSCN, "> $receivers"); | 
| 179 | – | print RADSCN '#@rfluxmtx ' . ($tensortree ? "h=sc$ns\n" : "h=kf\n"); | 
| 180 | – | print RADSCN '#@rfluxmtx ' . "u=Y o=$facedat\n\n"; | 
| 181 | – | print RADSCN "void glow receiver_face\n0\n0\n4 1 1 1 0\n\n"; | 
| 182 | – | print RADSCN "receiver_face source f_receiver\n0\n0\n4 0 0 1 180\n\n"; | 
| 183 | – | print RADSCN '#@rfluxmtx ' . "u=Y o=$behinddat\n\n"; | 
| 184 | – | print RADSCN "void glow receiver_behind\n0\n0\n4 1 1 1 0\n\n"; | 
| 185 | – | print RADSCN "receiver_behind source b_receiver\n0\n0\n4 0 0 -1 180\n"; | 
| 186 | – | close RADSCN; | 
| 187 | – | # Finish rfluxmtx command and prepare sender surfaces | 
| 195 |  | $rfluxmtx .= " -n $nproc -c $nsamp"; | 
| 196 | < | if ( $tensortree != 3 ) {       # Isotropic tensor tree is exception | 
| 197 | < | open (RADSCN, "> $fsender"); | 
| 198 | < | print RADSCN '#@rfluxmtx u=Y ' . ($tensortree ? "h=sc$ns\n\n" : "h=kf\n\n"); | 
| 199 | < | print RADSCN "void polygon fwd_sender\n0\n0\n12\n"; | 
| 200 | < | printf RADSCN "\t%f\t%f\t%f\n", $dim[0], $dim[2], $dim[4]; | 
| 201 | < | printf RADSCN "\t%f\t%f\t%f\n", $dim[0], $dim[3], $dim[4]; | 
| 202 | < | printf RADSCN "\t%f\t%f\t%f\n", $dim[1], $dim[3], $dim[4]; | 
| 203 | < | printf RADSCN "\t%f\t%f\t%f\n", $dim[1], $dim[2], $dim[4]; | 
| 196 | > | if ( !defined $recovery ) { | 
| 197 | > | open(MYAVH, "> $td/savedARGV.txt"); | 
| 198 | > | foreach (@savedARGV) { | 
| 199 | > | print MYAVH "$_\n"; | 
| 200 | > | } | 
| 201 | > | close MYAVH; | 
| 202 | > | # Generate octree | 
| 203 | > | system "oconv -w $radscn > $octree"; | 
| 204 | > | die "Could not compile scene\n" if ( $? ); | 
| 205 | > | # Add MGF description if requested | 
| 206 | > | if ( $geout ) { | 
| 207 | > | open(MGFSCN, "> $mgfscn"); | 
| 208 | > | printf MGFSCN "xf -t %.6f %.6f 0\n", -($dim[0]+$dim[1])/2, -($dim[2]+$dim[3])/2; | 
| 209 | > | close MGFSCN; | 
| 210 | > | if ( $mgfin ) { | 
| 211 | > | system qq{mgfilt "#,o,xf,c,cxy,cspec,cmix,m,sides,rd,td,rs,ts,ir,v,p,n,f,fh,sph,cyl,cone,prism,ring,torus" @ARGV >> $mgfscn}; | 
| 212 | > | } else { | 
| 213 | > | system "rad2mgf $radscn >> $mgfscn"; | 
| 214 | > | } | 
| 215 | > | open(MGFSCN, ">> $mgfscn"); | 
| 216 | > | print MGFSCN "xf\n"; | 
| 217 | > | close MGFSCN; | 
| 218 | > | } | 
| 219 | > | # Create receiver & sender surfaces (rectangular) | 
| 220 | > | open(RADSCN, "> $receivers"); | 
| 221 | > | print RADSCN '#@rfluxmtx ' . ($tensortree ? "h=-sc$ns\n" : "h=-kf\n"); | 
| 222 | > | print RADSCN '#@rfluxmtx ' . "u=-Y o=$facedat\n\n"; | 
| 223 | > | print RADSCN "void glow receiver_face\n0\n0\n4 1 1 1 0\n\n"; | 
| 224 | > | print RADSCN "receiver_face source f_receiver\n0\n0\n4 0 0 1 180\n\n"; | 
| 225 | > | print RADSCN '#@rfluxmtx ' . ($tensortree ? "h=+sc$ns\n" : "h=+kf\n"); | 
| 226 | > | print RADSCN '#@rfluxmtx ' . "u=-Y o=$behinddat\n\n"; | 
| 227 | > | print RADSCN "void glow receiver_behind\n0\n0\n4 1 1 1 0\n\n"; | 
| 228 | > | print RADSCN "receiver_behind source b_receiver\n0\n0\n4 0 0 -1 180\n"; | 
| 229 |  | close RADSCN; | 
| 230 | < | open (RADSCN, "> $bsender"); | 
| 231 | < | print RADSCN '#@rfluxmtx u=Y ' . ($tensortree ? "h=sc$ns\n\n" : "h=kf\n\n"); | 
| 232 | < | print RADSCN "void polygon fwd_sender\n0\n0\n12\n"; | 
| 233 | < | printf RADSCN "\t%f\t%f\t%f\n", $dim[0], $dim[2], $dim[5]; | 
| 234 | < | printf RADSCN "\t%f\t%f\t%f\n", $dim[1], $dim[2], $dim[5]; | 
| 235 | < | printf RADSCN "\t%f\t%f\t%f\n", $dim[1], $dim[3], $dim[5]; | 
| 236 | < | printf RADSCN "\t%f\t%f\t%f\n", $dim[0], $dim[3], $dim[5]; | 
| 237 | < | close RADSCN; | 
| 230 | > | # Prepare sender surfaces | 
| 231 | > | if ( $tensortree != 3 ) {       # Isotropic tensor tree is exception | 
| 232 | > | open (RADSCN, "> $fsender"); | 
| 233 | > | print RADSCN '#@rfluxmtx u=-Y ' . ($tensortree ? "h=-sc$ns\n\n" : "h=-kf\n\n"); | 
| 234 | > | print RADSCN "void polygon fwd_sender\n0\n0\n12\n"; | 
| 235 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[0], $dim[2], $dim[4]-$FEPS; | 
| 236 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[0], $dim[3], $dim[4]-$FEPS; | 
| 237 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[1], $dim[3], $dim[4]-$FEPS; | 
| 238 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[1], $dim[2], $dim[4]-$FEPS; | 
| 239 | > | close RADSCN; | 
| 240 | > | open (RADSCN, "> $bsender"); | 
| 241 | > | print RADSCN '#@rfluxmtx u=-Y ' . ($tensortree ? "h=+sc$ns\n\n" : "h=+kf\n\n"); | 
| 242 | > | print RADSCN "void polygon bwd_sender\n0\n0\n12\n"; | 
| 243 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[0], $dim[2], $dim[5]+$FEPS; | 
| 244 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[1], $dim[2], $dim[5]+$FEPS; | 
| 245 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[1], $dim[3], $dim[5]+$FEPS; | 
| 246 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[0], $dim[3], $dim[5]+$FEPS; | 
| 247 | > | close RADSCN; | 
| 248 | > | } | 
| 249 | > | print STDERR "Recover using: $0 -recover $td\n"; | 
| 250 |  | } | 
| 251 | + | # Open unbuffered progress file | 
| 252 | + | open(MYPH, ">> $td/phase.txt"); | 
| 253 | + | { | 
| 254 | + | my $ofh = select MYPH; | 
| 255 | + | $| = 1; | 
| 256 | + | select $ofh; | 
| 257 | + | } | 
| 258 | + | $curphase = 0; | 
| 259 |  | # Create data segments (all the work happens here) | 
| 260 |  | if ( $tensortree ) { | 
| 261 |  | do_tree_bsdf(); | 
| 263 |  | do_matrix_bsdf(); | 
| 264 |  | } | 
| 265 |  | # Output XML | 
| 214 | – | my $old_fh = select(STDOUT); | 
| 215 | – | $| = 1; | 
| 216 | – | select($old_fh); | 
| 217 | – | print "<!-- Created by: genBSDF @savedARGV -->\n"; | 
| 266 |  | # print STDERR "Running: $wrapper\n"; | 
| 267 | < | system $wrapper; | 
| 267 | > | system "$wrapper -C \"Created by: genBSDF @savedARGV\""; | 
| 268 |  | die "Could not wrap BSDF data\n" if ( $? ); | 
| 269 |  | # Clean up temporary files and exit | 
| 270 | < | system $rmtmp; | 
| 270 | > | exec $rmtmp; | 
| 271 |  |  | 
| 272 | < | #-------------- End of main program segment --------------# | 
| 272 | > | #============== End of main program segment ==============# | 
| 273 |  |  | 
| 274 | + | # Function to determine if next phase should be skipped or recovered | 
| 275 | + | sub do_phase { | 
| 276 | + | $curphase++; | 
| 277 | + | if (defined $recovery) { | 
| 278 | + | if ($recovery > $curphase) { return 0; } | 
| 279 | + | if ($recovery == $curphase) { return -1; } | 
| 280 | + | } | 
| 281 | + | print MYPH "$curphase\n"; | 
| 282 | + | return 1; | 
| 283 | + | } | 
| 284 | + |  | 
| 285 |  | #++++++++++++++ Tensor tree BSDF generation ++++++++++++++# | 
| 286 |  | sub do_tree_bsdf { | 
| 287 |  |  | 
| 294 |  | # Call rfluxmtx and process tensor tree BSDF for the given direction | 
| 295 |  | sub do_ttree_dir { | 
| 296 |  | my $forw = shift; | 
| 297 | + | my $r = do_phase(); | 
| 298 | + | if (!$r) { return; } | 
| 299 | + | $r = ($r < 0) ? " -r" : ""; | 
| 300 |  | my $cmd; | 
| 301 |  | if ( $tensortree == 3 ) { | 
| 302 |  | # Isotropic BSDF | 
| 312 |  | qq{-e "zp=$dim[5-$forw]" -e "myDz=Dz*($forw*2-1)" } . | 
| 313 |  | qq{-e "\$1=xp-Dx;\$2=yp-Dy;\$3=zp-myDz" } . | 
| 314 |  | qq{-e "\$4=Dx;\$5=Dy;\$6=myDz" } . | 
| 315 | < | "| $rfluxmtx -fa -y $ns2 - $receivers -i $octree"; | 
| 315 | > | "| $rfluxmtx$r -fa -y $ns2 - $receivers -i $octree"; | 
| 316 |  | } else { | 
| 317 |  | $cmd = "cnt $ns2 $ny $nx " . | 
| 318 |  | qq{| rcalc -e "r1=rand(.8681*recno-.673892)" } . | 
| 324 |  | qq{-e "zp=$dim[5-$forw]" -e "myDz=Dz*($forw*2-1)" } . | 
| 325 |  | qq{-e '\$1=xp-Dx;\$2=yp-Dy;\$3=zp-myDz' } . | 
| 326 |  | qq{-e '\$4=Dx;\$5=Dy;\$6=myDz' -of } . | 
| 327 | < | "| $rfluxmtx -h -ff -y $ns2 - $receivers -i $octree"; | 
| 327 | > | "| $rfluxmtx$r -h -ff -y $ns2 - $receivers -i $octree"; | 
| 328 |  | } | 
| 329 |  | } else { | 
| 330 |  | # Anisotropic BSDF | 
| 331 |  | my $sender = ($bsender,$fsender)[$forw]; | 
| 332 |  | if ($windoz) { | 
| 333 | < | $cmd = "$rfluxmtx -fa $sender $receivers -i $octree"; | 
| 333 | > | $cmd = "$rfluxmtx$r -fa $sender $receivers -i $octree"; | 
| 334 |  | } else { | 
| 335 | < | $cmd = "$rfluxmtx -h -ff $sender $receivers -i $octree"; | 
| 335 | > | $cmd = "$rfluxmtx$r -h -ff $sender $receivers -i $octree"; | 
| 336 |  | } | 
| 337 |  | } | 
| 338 |  | # print STDERR "Starting: $cmd\n"; | 
| 357 |  | my $ttyp = ("tb","tf")[$forw]; | 
| 358 |  | ttree_comp($ttyp, "Visible", $transdat, ($tb,$tf)[$forw]); | 
| 359 |  | if ( $docolor ) { | 
| 360 | < | ttree_comp($ttyp, "CIE-X", $transdat, ($tbx,$tfx)[$forw]); | 
| 361 | < | ttree_comp($ttyp, "CIE-Z", $transdat, ($tbz,$tfz)[$forw]); | 
| 360 | > | ttree_comp($ttyp, "CIE-u", $transdat, ($tbx,$tfx)[$forw]); | 
| 361 | > | ttree_comp($ttyp, "CIE-v", $transdat, ($tbz,$tfz)[$forw]); | 
| 362 |  | } | 
| 363 |  | } | 
| 364 |  | # Output reflection | 
| 365 |  | my $rtyp = ("rb","rf")[$forw]; | 
| 366 |  | ttree_comp($rtyp, "Visible", $refldat, ($rb,$rf)[$forw]); | 
| 367 |  | if ( $docolor ) { | 
| 368 | < | ttree_comp($rtyp, "CIE-X", $refldat, ($rbx,$rfx)[$forw]); | 
| 369 | < | ttree_comp($rtyp, "CIE-Z", $refldat, ($rbz,$rfz)[$forw]); | 
| 368 | > | ttree_comp($rtyp, "CIE-u", $refldat, ($rbx,$rfx)[$forw]); | 
| 369 | > | ttree_comp($rtyp, "CIE-v", $refldat, ($rbz,$rfz)[$forw]); | 
| 370 |  | } | 
| 371 |  | }       # end of ttree_out() | 
| 372 |  |  | 
| 380 |  | if ($windoz) { | 
| 381 |  | if ("$spec" eq "Visible") { | 
| 382 |  | $cmd = qq{rcalc -e "Omega:PI/($ns*$ns)" } . | 
| 383 | < | q{-e "$1=(0.265*$1+0.670*$2+0.065*$3)/Omega"}; | 
| 384 | < | } elsif ("$spec" eq "CIE-X") { | 
| 385 | < | $cmd = qq{rcalc -e "Omega:PI/($ns*$ns)" } . | 
| 386 | < | q{-e "$1=(0.514*$1+0.324*$2+0.162*$3)/Omega"}; | 
| 387 | < | } elsif ("$spec" eq "CIE-Z") { | 
| 388 | < | $cmd = qq{rcalc -e "Omega:PI/($ns*$ns)" } . | 
| 389 | < | q{-e "$1=(0.024*$1+0.123*$2+0.853*$3)/Omega"}; | 
| 383 | > | q{-e "Ri=$1;Gi=$2;Bi=$3" } . | 
| 384 | > | qq{-e "$CIEuv" } . | 
| 385 | > | q{-e "$1=Yi/Omega"}; | 
| 386 | > | } elsif ("$spec" eq "CIE-u") { | 
| 387 | > | $cmd = q{rcalc -e "Ri=$1;Gi=$2;Bi=$3" } . | 
| 388 | > | qq{-e "$CIEuv" } . | 
| 389 | > | q{-e "$1=uprime"}; | 
| 390 | > | } elsif ("$spec" eq "CIE-v") { | 
| 391 | > | $cmd = q{rcalc -e "Ri=$1;Gi=$2;Bi=$3" } . | 
| 392 | > | qq{-e "$CIEuv" } . | 
| 393 | > | q{-e "$1=vprime"}; | 
| 394 |  | } | 
| 395 |  | } else { | 
| 396 |  | if ("$spec" eq "Visible") { | 
| 397 |  | $cmd = "rcalc -if3 -e 'Omega:PI/($ns*$ns)' " . | 
| 398 | < | q{-e '$1=(0.265*$1+0.670*$2+0.065*$3)/Omega'}; | 
| 399 | < | } elsif ("$spec" eq "CIE-X") { | 
| 400 | < | $cmd = "rcalc -if3 -e 'Omega:PI/($ns*$ns)' " . | 
| 401 | < | q{-e '$1=(0.514*$1+0.324*$2+0.162*$3)/Omega'}; | 
| 402 | < | } elsif ("$spec" eq "CIE-Z") { | 
| 403 | < | $cmd = "rcalc -if3 -e 'Omega:PI/($ns*$ns)' " . | 
| 404 | < | q{-e '$1=(0.024*$1+0.123*$2+0.853*$3)/Omega'}; | 
| 398 | > | q{-e 'Ri=$1;Gi=$2;Bi=$3' } . | 
| 399 | > | "-e '$CIEuv' " . | 
| 400 | > | q{-e '$1=Yi/Omega'}; | 
| 401 | > | } elsif ("$spec" eq "CIE-u") { | 
| 402 | > | $cmd = q{rcalc -if3 -e 'Ri=$1;Gi=$2;Bi=$3' } . | 
| 403 | > | "-e '$CIEuv' " . | 
| 404 | > | q{-e '$1=uprime'}; | 
| 405 | > | } elsif ("$spec" eq "CIE-v") { | 
| 406 | > | $cmd = q{rcalc -if3 -e 'Ri=$1;Gi=$2;Bi=$3' } . | 
| 407 | > | "-e '$CIEuv' " . | 
| 408 | > | q{-e '$1=vprime'}; | 
| 409 |  | } | 
| 410 |  | } | 
| 411 |  | if ($pctcull >= 0) { | 
| 412 |  | my $avg = ( "$typ" =~ /^r[fb]/ ) ? " -a" : ""; | 
| 413 | + | my $pcull = ("$spec" eq "Visible") ? $pctcull : | 
| 414 | + | (100 - (100-$pctcull)*.25) ; | 
| 415 |  | if ($windoz) { | 
| 416 |  | $cmd = "rcollate -ho -oc 1 $src | " . | 
| 417 |  | $cmd . | 
| 418 | < | " | rttree_reduce$avg -h -fa -t $pctcull -r $tensortree -g $ttlog2"; | 
| 418 | > | " | rttree_reduce$avg -h -fa -t $pcull -r $tensortree -g $ttlog2"; | 
| 419 |  | } else { | 
| 420 |  | $cmd .= " -of $src " . | 
| 421 | < | "| rttree_reduce$avg -h -ff -t $pctcull -r $tensortree -g $ttlog2"; | 
| 421 | > | "| rttree_reduce$avg -h -ff -t $pcull -r $tensortree -g $ttlog2"; | 
| 422 |  | } | 
| 423 |  | # print STDERR "Running: $cmd\n"; | 
| 424 |  | system "$cmd > $dest"; | 
| 443 |  | close DATOUT; | 
| 444 |  | } | 
| 445 |  | if ( "$spec" ne "$curspec" ) { | 
| 446 | < | $wrapper .= " -s $spec" | 
| 446 | > | $wrapper .= " -s $spec"; | 
| 447 |  | $curspec = $spec; | 
| 448 |  | } | 
| 449 |  | $wrapper .= " -$typ $dest"; | 
| 463 |  | # Call rfluxmtx and process tensor tree BSDF for the given direction | 
| 464 |  | sub do_matrix_dir { | 
| 465 |  | my $forw = shift; | 
| 466 | + | my $r = do_phase(); | 
| 467 | + | if (!$r) { return; } | 
| 468 | + | $r = ($r < 0) ? " -r" : ""; | 
| 469 |  | my $cmd; | 
| 470 |  | my $sender = ($bsender,$fsender)[$forw]; | 
| 471 | < | $cmd = "$rfluxmtx -fd $sender $receivers -i $octree"; | 
| 471 | > | $cmd = "$rfluxmtx$r -fd $sender $receivers -i $octree"; | 
| 472 |  | # print STDERR "Starting: $cmd\n"; | 
| 473 |  | system $cmd; | 
| 474 |  | die "Failure running rfluxmtx" if ( $? ); | 
| 509 |  | my $dest = shift; | 
| 510 |  | my $cmd = "rmtxop -fa -t"; | 
| 511 |  | if ("$spec" eq "Visible") { | 
| 512 | < | $cmd .= " -c 0.265 0.670 0.065"; | 
| 512 | > | $cmd .= " -c 0.2651 0.6701 0.0648"; | 
| 513 |  | } elsif ("$spec" eq "CIE-X") { | 
| 514 | < | $cmd .= " -c 0.514 0.324 0.162"; | 
| 514 | > | $cmd .= " -c 0.5141 0.3239 0.1620"; | 
| 515 |  | } elsif ("$spec" eq "CIE-Z") { | 
| 516 | < | $cmd .= " -c 0.024 0.123 0.853"; | 
| 516 | > | $cmd .= " -c 0.0241 0.1229 0.8530"; | 
| 517 |  | } | 
| 518 | < | $cmd .= " $src | getinfo -"; | 
| 518 | > | $cmd .= " $src | rcollate -ho -oc 145"; | 
| 519 |  | # print STDERR "Running: $cmd\n"; | 
| 520 |  | system "$cmd > $dest"; | 
| 521 | < | die "Failure running rttree_reduce" if ( $? ); | 
| 521 | > | die "Failure running rmtxop" if ( $? ); | 
| 522 |  | if ( "$spec" ne "$curspec" ) { | 
| 523 | < | $wrapper .= " -s $spec" | 
| 523 | > | $wrapper .= " -s $spec"; | 
| 524 |  | $curspec = $spec; | 
| 525 |  | } | 
| 526 |  | $wrapper .= " -$typ $dest"; |