| 1 | greg | 2.1 | #!/usr/bin/perl -w | 
| 2 | greg | 2.51 | # RCSid $Id: genBSDF.pl,v 2.50 2015/03/04 17:42:54 greg Exp $ | 
| 3 | greg | 2.1 | # | 
| 4 |  |  | # Compute BSDF based on geometry and material description | 
| 5 |  |  | # | 
| 6 |  |  | #       G. Ward | 
| 7 |  |  | # | 
| 8 |  |  | use strict; | 
| 9 | greg | 2.47 | my $windoz = ($^O eq "MSWin32" or $^O eq "MSWin64"); | 
| 10 | greg | 2.13 | use File::Temp qw/ :mktemp  /; | 
| 11 | greg | 2.1 | sub userror { | 
| 12 | greg | 2.49 | 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"; | 
| 13 | greg | 2.1 | exit 1; | 
| 14 |  |  | } | 
| 15 | greg | 2.49 | 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 | greg | 2.47 | if ($windoz) { | 
| 18 |  |  | my $tmploc = `echo \%TMP\%`; | 
| 19 |  |  | chomp($tmploc); | 
| 20 |  |  | $td = mkdtemp("$tmploc\\genBSDF.XXXXXX"); | 
| 21 |  |  | $radscn = "$td\\device.rad"; | 
| 22 |  |  | $mgfscn = "$td\\device.mgf"; | 
| 23 |  |  | $octree = "$td\\device.oct"; | 
| 24 | greg | 2.49 | $fsender = "$td\\fsender.rad"; | 
| 25 |  |  | $bsender = "$td\\bsender.rad"; | 
| 26 |  |  | $receivers = "$td\\receivers.rad"; | 
| 27 |  |  | $facedat = "$td\\face.dat"; | 
| 28 |  |  | $behinddat = "$td\\behind.dat"; | 
| 29 |  |  | $tf = "$td\\tf.dat"; | 
| 30 |  |  | $rf = "$td\\rf.dat"; | 
| 31 |  |  | $tb = "$td\\tb.dat"; | 
| 32 |  |  | $rb = "$td\\rb.dat"; | 
| 33 |  |  | $tfx = "$td\\tfx.dat"; | 
| 34 |  |  | $rfx = "$td\\rfx.dat"; | 
| 35 |  |  | $tbx = "$td\\tbx.dat"; | 
| 36 |  |  | $rbx = "$td\\rbx.dat"; | 
| 37 |  |  | $tfz = "$td\\tfz.dat"; | 
| 38 |  |  | $rfz = "$td\\rfz.dat"; | 
| 39 |  |  | $tbz = "$td\\tbz.dat"; | 
| 40 |  |  | $rbz = "$td\\rbz.dat"; | 
| 41 | greg | 2.47 | chomp $td; | 
| 42 |  |  | $rmtmp = "rmdir /S /Q $td"; | 
| 43 | greg | 2.49 | } else { | 
| 44 | greg | 2.47 | $td = mkdtemp("/tmp/genBSDF.XXXXXX"); | 
| 45 |  |  | chomp $td; | 
| 46 |  |  | $radscn = "$td/device.rad"; | 
| 47 |  |  | $mgfscn = "$td/device.mgf"; | 
| 48 |  |  | $octree = "$td/device.oct"; | 
| 49 | greg | 2.49 | $fsender = "$td/fsender.rad"; | 
| 50 |  |  | $bsender = "$td/bsender.rad"; | 
| 51 |  |  | $receivers = "$td/receivers.rad"; | 
| 52 |  |  | $facedat = "$td/face.dat"; | 
| 53 |  |  | $behinddat = "$td/behind.dat"; | 
| 54 |  |  | $tf = "$td/tf.dat"; | 
| 55 |  |  | $rf = "$td/rf.dat"; | 
| 56 |  |  | $tb = "$td/tb.dat"; | 
| 57 |  |  | $rb = "$td/rb.dat"; | 
| 58 |  |  | $tfx = "$td/tfx.dat"; | 
| 59 |  |  | $rfx = "$td/rfx.dat"; | 
| 60 |  |  | $tbx = "$td/tbx.dat"; | 
| 61 |  |  | $rbx = "$td/rbx.dat"; | 
| 62 |  |  | $tfz = "$td/tfz.dat"; | 
| 63 |  |  | $rfz = "$td/rfz.dat"; | 
| 64 |  |  | $tbz = "$td/tbz.dat"; | 
| 65 |  |  | $rbz = "$td/rbz.dat"; | 
| 66 | greg | 2.47 | $rmtmp = "rm -rf $td"; | 
| 67 |  |  | } | 
| 68 | greg | 2.20 | my @savedARGV = @ARGV; | 
| 69 | greg | 2.49 | my $rfluxmtx = "rfluxmtx -v -ab 5 -ad 700 -lw 3e-6"; | 
| 70 |  |  | my $wrapper = "wrapBSDF"; | 
| 71 | greg | 2.15 | my $tensortree = 0; | 
| 72 |  |  | my $ttlog2 = 4; | 
| 73 | greg | 2.25 | my $nsamp = 2000; | 
| 74 | greg | 2.1 | my $mgfin = 0; | 
| 75 |  |  | my $geout = 1; | 
| 76 |  |  | my $nproc = 1; | 
| 77 | greg | 2.49 | my $docolor = 0; | 
| 78 | greg | 2.9 | my $doforw = 0; | 
| 79 |  |  | my $doback = 1; | 
| 80 | greg | 2.33 | my $pctcull = 90; | 
| 81 | greg | 2.41 | my $gunit = "meter"; | 
| 82 | greg | 2.49 | my $curspec = "Visible"; | 
| 83 | greg | 2.1 | my @dim; | 
| 84 |  |  | # Get options | 
| 85 |  |  | while ($#ARGV >= 0) { | 
| 86 |  |  | if ("$ARGV[0]" =~ /^[-+]m/) { | 
| 87 |  |  | $mgfin = ("$ARGV[0]" =~ /^\+/); | 
| 88 | greg | 2.10 | } elsif ("$ARGV[0]" eq "-r") { | 
| 89 | greg | 2.49 | $rfluxmtx .= " $ARGV[1]"; | 
| 90 | greg | 2.10 | shift @ARGV; | 
| 91 | greg | 2.1 | } elsif ("$ARGV[0]" =~ /^[-+]g/) { | 
| 92 |  |  | $geout = ("$ARGV[0]" =~ /^\+/); | 
| 93 | greg | 2.22 | $gunit = $ARGV[1]; | 
| 94 |  |  | if ($gunit !~ /^(?i)(meter|foot|inch|centimeter|millimeter)$/) { | 
| 95 |  |  | die "Illegal geometry unit '$gunit': must be meter, foot, inch, centimeter, or millimeter\n"; | 
| 96 |  |  | } | 
| 97 |  |  | shift @ARGV; | 
| 98 | greg | 2.49 | } elsif ("$ARGV[0]" =~ /^[-+]C/) { | 
| 99 |  |  | $docolor = ("$ARGV[0]" =~ /^\+/); | 
| 100 | greg | 2.9 | } elsif ("$ARGV[0]" =~ /^[-+]f/) { | 
| 101 |  |  | $doforw = ("$ARGV[0]" =~ /^\+/); | 
| 102 |  |  | } elsif ("$ARGV[0]" =~ /^[-+]b/) { | 
| 103 |  |  | $doback = ("$ARGV[0]" =~ /^\+/); | 
| 104 | greg | 2.27 | } elsif ("$ARGV[0]" eq "-t") { | 
| 105 | greg | 2.33 | # Use value < 0 for rttree_reduce bypass | 
| 106 | greg | 2.27 | $pctcull = $ARGV[1]; | 
| 107 |  |  | shift @ARGV; | 
| 108 | greg | 2.15 | } elsif ("$ARGV[0]" =~ /^-t[34]$/) { | 
| 109 |  |  | $tensortree = substr($ARGV[0], 2, 1); | 
| 110 |  |  | $ttlog2 = $ARGV[1]; | 
| 111 |  |  | shift @ARGV; | 
| 112 | greg | 2.49 | } elsif ("$ARGV[0]" eq "-f") { | 
| 113 |  |  | $wrapper .= " -f \"$ARGV[1]\""; | 
| 114 |  |  | shift @ARGV; | 
| 115 |  |  | } elsif ("$ARGV[0]" eq "-W") { | 
| 116 |  |  | $wrapper .= " -W"; | 
| 117 | greg | 2.1 | } elsif ("$ARGV[0]" eq "-c") { | 
| 118 |  |  | $nsamp = $ARGV[1]; | 
| 119 |  |  | shift @ARGV; | 
| 120 |  |  | } elsif ("$ARGV[0]" eq "-n") { | 
| 121 |  |  | $nproc = $ARGV[1]; | 
| 122 |  |  | shift @ARGV; | 
| 123 |  |  | } elsif ("$ARGV[0]" =~ /^-d/) { | 
| 124 |  |  | userror() if ($#ARGV < 6); | 
| 125 | greg | 2.8 | @dim = @ARGV[1..6]; | 
| 126 | greg | 2.1 | shift @ARGV for (1..6); | 
| 127 |  |  | } elsif ("$ARGV[0]" =~ /^[-+]./) { | 
| 128 |  |  | userror(); | 
| 129 |  |  | } else { | 
| 130 |  |  | last; | 
| 131 |  |  | } | 
| 132 |  |  | shift @ARGV; | 
| 133 |  |  | } | 
| 134 | greg | 2.9 | # Check that we're actually being asked to do something | 
| 135 | greg | 2.15 | die "Must have at least one of +forward or +backward\n" if (!$doforw && !$doback); | 
| 136 | greg | 2.48 | # Issue warning for unhandled reciprocity case | 
| 137 | greg | 2.49 | print STDERR "Warning: recommend both +forward and +backward with -t3\n" if | 
| 138 | greg | 2.48 | ($tensortree==3 && !($doforw && $doback)); | 
| 139 | greg | 2.49 | $wrapper .= $tensortree ? " -a t$tensortree" : " -a kf -c"; | 
| 140 |  |  | $wrapper .= " -u $gunit"; | 
| 141 | greg | 2.1 | # Get scene description and dimensions | 
| 142 |  |  | if ( $mgfin ) { | 
| 143 | greg | 2.49 | system "mgf2rad @ARGV > $radscn"; | 
| 144 | greg | 2.1 | die "Could not load MGF input\n" if ( $? ); | 
| 145 |  |  | } else { | 
| 146 | greg | 2.13 | system "xform -e @ARGV > $radscn"; | 
| 147 | greg | 2.1 | die "Could not load Radiance input\n" if ( $? ); | 
| 148 |  |  | } | 
| 149 |  |  | if ($#dim != 5) { | 
| 150 | greg | 2.7 | @dim = split ' ', `getbbox -h $radscn`; | 
| 151 | greg | 2.1 | } | 
| 152 |  |  | print STDERR "Warning: Device extends into room\n" if ($dim[5] > 1e-5); | 
| 153 | greg | 2.49 | $wrapper .= ' -f "t=' . ($dim[5] - $dim[4]) . ';w=' . ($dim[1] - $dim[0]) . | 
| 154 |  |  | ';h=' . ($dim[3] - $dim[2]) . '"'; | 
| 155 | greg | 2.1 | # Generate octree | 
| 156 |  |  | system "oconv -w $radscn > $octree"; | 
| 157 |  |  | die "Could not compile scene\n" if ( $? ); | 
| 158 | greg | 2.49 | # Add MGF description if requested | 
| 159 | greg | 2.15 | if ( $geout ) { | 
| 160 | greg | 2.49 | 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; | 
| 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}; | 
| 165 |  |  | } else { | 
| 166 |  |  | system "rad2mgf $radscn >> $mgfscn"; | 
| 167 |  |  | } | 
| 168 |  |  | open(MGFSCN, ">> $mgfscn"); | 
| 169 |  |  | print MGFSCN "xf\n"; | 
| 170 | greg | 2.15 | close MGFSCN; | 
| 171 | greg | 2.49 | $wrapper .= " -g $mgfscn"; | 
| 172 | greg | 2.15 | } | 
| 173 | greg | 2.49 | # Create receiver & sender surfaces (rectangular) | 
| 174 | greg | 2.46 | my $nx = int(sqrt($nsamp*($dim[1]-$dim[0])/($dim[3]-$dim[2])) + 1); | 
| 175 |  |  | my $ny = int($nsamp/$nx + 1); | 
| 176 | greg | 2.15 | $nsamp = $nx * $ny; | 
| 177 |  |  | my $ns = 2**$ttlog2; | 
| 178 | greg | 2.49 | 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 | 
| 188 |  |  | $rfluxmtx .= " -n $nproc -c $nsamp"; | 
| 189 |  |  | if ( $tensortree != 3 ) {       # Isotropic tensor tree is exception | 
| 190 |  |  | open (RADSCN, "> $fsender"); | 
| 191 |  |  | print RADSCN '#@rfluxmtx u=Y ' . ($tensortree ? "h=sc$ns\n\n" : "h=kf\n\n"); | 
| 192 |  |  | print RADSCN "void polygon fwd_sender\n0\n0\n12\n"; | 
| 193 |  |  | printf RADSCN "\t%f\t%f\t%f\n", $dim[0], $dim[2], $dim[4]; | 
| 194 |  |  | printf RADSCN "\t%f\t%f\t%f\n", $dim[0], $dim[3], $dim[4]; | 
| 195 |  |  | printf RADSCN "\t%f\t%f\t%f\n", $dim[1], $dim[3], $dim[4]; | 
| 196 |  |  | printf RADSCN "\t%f\t%f\t%f\n", $dim[1], $dim[2], $dim[4]; | 
| 197 |  |  | close RADSCN; | 
| 198 |  |  | open (RADSCN, "> $bsender"); | 
| 199 |  |  | print RADSCN '#@rfluxmtx u=Y ' . ($tensortree ? "h=sc$ns\n\n" : "h=kf\n\n"); | 
| 200 |  |  | print RADSCN "void polygon fwd_sender\n0\n0\n12\n"; | 
| 201 |  |  | printf RADSCN "\t%f\t%f\t%f\n", $dim[0], $dim[2], $dim[5]; | 
| 202 |  |  | printf RADSCN "\t%f\t%f\t%f\n", $dim[1], $dim[2], $dim[5]; | 
| 203 |  |  | printf RADSCN "\t%f\t%f\t%f\n", $dim[1], $dim[3], $dim[5]; | 
| 204 |  |  | printf RADSCN "\t%f\t%f\t%f\n", $dim[0], $dim[3], $dim[5]; | 
| 205 |  |  | close RADSCN; | 
| 206 |  |  | } | 
| 207 | greg | 2.15 | # Create data segments (all the work happens here) | 
| 208 |  |  | if ( $tensortree ) { | 
| 209 |  |  | do_tree_bsdf(); | 
| 210 |  |  | } else { | 
| 211 |  |  | do_matrix_bsdf(); | 
| 212 |  |  | } | 
| 213 | greg | 2.49 | # Output XML | 
| 214 |  |  | my $old_fh = select(STDOUT); | 
| 215 |  |  | $| = 1; | 
| 216 |  |  | select($old_fh); | 
| 217 |  |  | print "<!-- Created by: genBSDF @savedARGV -->\n"; | 
| 218 |  |  | # print STDERR "Running: $wrapper\n"; | 
| 219 |  |  | system $wrapper; | 
| 220 |  |  | die "Could not wrap BSDF data\n" if ( $? ); | 
| 221 | greg | 2.15 | # Clean up temporary files and exit | 
| 222 | greg | 2.47 | system $rmtmp; | 
| 223 | greg | 2.16 |  | 
| 224 | greg | 2.15 | #-------------- End of main program segment --------------# | 
| 225 |  |  |  | 
| 226 |  |  | #++++++++++++++ Tensor tree BSDF generation ++++++++++++++# | 
| 227 |  |  | sub do_tree_bsdf { | 
| 228 | greg | 2.49 |  | 
| 229 |  |  | # Run rfluxmtx processes to compute each side | 
| 230 |  |  | do_ttree_dir(0) if ( $doback ); | 
| 231 |  |  | do_ttree_dir(1) if ( $doforw ); | 
| 232 | greg | 2.36 |  | 
| 233 | greg | 2.15 | }       # end of sub do_tree_bsdf() | 
| 234 |  |  |  | 
| 235 | greg | 2.49 | # Call rfluxmtx and process tensor tree BSDF for the given direction | 
| 236 |  |  | sub do_ttree_dir { | 
| 237 | greg | 2.15 | my $forw = shift; | 
| 238 | greg | 2.47 | my $cmd; | 
| 239 | greg | 2.15 | if ( $tensortree == 3 ) { | 
| 240 |  |  | # Isotropic BSDF | 
| 241 | greg | 2.36 | my $ns2 = $ns / 2; | 
| 242 | greg | 2.47 | if ($windoz) { | 
| 243 |  |  | $cmd = "cnt $ns2 $ny $nx " . | 
| 244 |  |  | qq{| rcalc -e "r1=rand(.8681*recno-.673892)" } . | 
| 245 |  |  | qq{-e "r2=rand(-5.37138*recno+67.1737811)" } . | 
| 246 |  |  | qq{-e "r3=rand(+3.17603772*recno+83.766771)" } . | 
| 247 |  |  | qq{-e "Dx=1-2*(\$1+r1)/$ns;Dy:0;Dz=sqrt(1-Dx*Dx)" } . | 
| 248 |  |  | qq{-e "xp=(\$3+r2)*(($dim[1]-$dim[0])/$nx)+$dim[0]" } . | 
| 249 |  |  | qq{-e "yp=(\$2+r3)*(($dim[3]-$dim[2])/$ny)+$dim[2]" } . | 
| 250 |  |  | qq{-e "zp=$dim[5-$forw]" -e "myDz=Dz*($forw*2-1)" } . | 
| 251 |  |  | qq{-e "\$1=xp-Dx;\$2=yp-Dy;\$3=zp-myDz" } . | 
| 252 |  |  | qq{-e "\$4=Dx;\$5=Dy;\$6=myDz" } . | 
| 253 | greg | 2.49 | "| $rfluxmtx -fa -y $ns2 - $receivers -i $octree"; | 
| 254 | greg | 2.47 | } else { | 
| 255 |  |  | $cmd = "cnt $ns2 $ny $nx " . | 
| 256 |  |  | qq{| rcalc -e "r1=rand(.8681*recno-.673892)" } . | 
| 257 |  |  | qq{-e "r2=rand(-5.37138*recno+67.1737811)" } . | 
| 258 |  |  | qq{-e "r3=rand(+3.17603772*recno+83.766771)" } . | 
| 259 |  |  | qq{-e "Dx=1-2*(\$1+r1)/$ns;Dy:0;Dz=sqrt(1-Dx*Dx)" } . | 
| 260 |  |  | qq{-e "xp=(\$3+r2)*(($dim[1]-$dim[0])/$nx)+$dim[0]" } . | 
| 261 |  |  | qq{-e "yp=(\$2+r3)*(($dim[3]-$dim[2])/$ny)+$dim[2]" } . | 
| 262 |  |  | qq{-e "zp=$dim[5-$forw]" -e "myDz=Dz*($forw*2-1)" } . | 
| 263 |  |  | qq{-e '\$1=xp-Dx;\$2=yp-Dy;\$3=zp-myDz' } . | 
| 264 |  |  | qq{-e '\$4=Dx;\$5=Dy;\$6=myDz' -of } . | 
| 265 | greg | 2.49 | "| $rfluxmtx -h -ff -y $ns2 - $receivers -i $octree"; | 
| 266 | greg | 2.47 | } | 
| 267 | greg | 2.15 | } else { | 
| 268 |  |  | # Anisotropic BSDF | 
| 269 | greg | 2.49 | my $sender = ($bsender,$fsender)[$forw]; | 
| 270 | greg | 2.47 | if ($windoz) { | 
| 271 | greg | 2.49 | $cmd = "$rfluxmtx -fa $sender $receivers -i $octree"; | 
| 272 | greg | 2.47 | } else { | 
| 273 | greg | 2.49 | $cmd = "$rfluxmtx -h -ff $sender $receivers -i $octree"; | 
| 274 | greg | 2.47 | } | 
| 275 | greg | 2.15 | } | 
| 276 | greg | 2.49 | # print STDERR "Starting: $cmd\n"; | 
| 277 |  |  | system $cmd; | 
| 278 |  |  | die "Failure running rfluxmtx" if ( $? ); | 
| 279 | greg | 2.36 | ttree_out($forw); | 
| 280 | greg | 2.49 | }       # end of do_ttree_dir() | 
| 281 | greg | 2.15 |  | 
| 282 | greg | 2.49 | # Simplify and store tensor tree results | 
| 283 | greg | 2.15 | sub ttree_out { | 
| 284 |  |  | my $forw = shift; | 
| 285 | greg | 2.49 | my ($refldat,$transdat); | 
| 286 |  |  | if ( $forw ) { | 
| 287 |  |  | $transdat = $facedat; | 
| 288 |  |  | $refldat = $behinddat; | 
| 289 | greg | 2.47 | } else { | 
| 290 | greg | 2.49 | $transdat = $behinddat; | 
| 291 |  |  | $refldat = $facedat; | 
| 292 | greg | 2.47 | } | 
| 293 | greg | 2.49 | # Only output one transmitted anisotropic distribution, preferring backwards | 
| 294 |  |  | if ( !$forw || !$doback || $tensortree==3 ) { | 
| 295 |  |  | my $ttyp = ("tb","tf")[$forw]; | 
| 296 |  |  | ttree_comp($ttyp, "Visible", $transdat, ($tb,$tf)[$forw]); | 
| 297 |  |  | if ( $docolor ) { | 
| 298 |  |  | ttree_comp($ttyp, "CIE-X", $transdat, ($tbx,$tfx)[$forw]); | 
| 299 |  |  | ttree_comp($ttyp, "CIE-Z", $transdat, ($tbz,$tfz)[$forw]); | 
| 300 |  |  | } | 
| 301 | greg | 2.47 | } | 
| 302 | greg | 2.49 | # Output reflection | 
| 303 |  |  | my $rtyp = ("rb","rf")[$forw]; | 
| 304 |  |  | ttree_comp($rtyp, "Visible", $refldat, ($rb,$rf)[$forw]); | 
| 305 |  |  | if ( $docolor ) { | 
| 306 |  |  | ttree_comp($rtyp, "CIE-X", $refldat, ($rbx,$rfx)[$forw]); | 
| 307 |  |  | ttree_comp($rtyp, "CIE-Z", $refldat, ($rbz,$rfz)[$forw]); | 
| 308 | greg | 2.34 | } | 
| 309 | greg | 2.49 | }       # end of ttree_out() | 
| 310 |  |  |  | 
| 311 |  |  | # Call rttree_reduce on the given component | 
| 312 |  |  | sub ttree_comp { | 
| 313 |  |  | my $typ = shift; | 
| 314 |  |  | my $spec = shift; | 
| 315 |  |  | my $src = shift; | 
| 316 |  |  | my $dest = shift; | 
| 317 |  |  | my $cmd; | 
| 318 | greg | 2.47 | if ($windoz) { | 
| 319 | greg | 2.49 | if ("$spec" eq "Visible") { | 
| 320 |  |  | $cmd = qq{rcalc -e "Omega:PI/($ns*$ns)" } . | 
| 321 |  |  | q{-e "$1=(0.265*$1+0.670*$2+0.065*$3)/Omega"}; | 
| 322 |  |  | } elsif ("$spec" eq "CIE-X") { | 
| 323 |  |  | $cmd = qq{rcalc -e "Omega:PI/($ns*$ns)" } . | 
| 324 |  |  | q{-e "$1=(0.514*$1+0.324*$2+0.162*$3)/Omega"}; | 
| 325 |  |  | } elsif ("$spec" eq "CIE-Z") { | 
| 326 |  |  | $cmd = qq{rcalc -e "Omega:PI/($ns*$ns)" } . | 
| 327 |  |  | q{-e "$1=(0.024*$1+0.123*$2+0.853*$3)/Omega"}; | 
| 328 |  |  | } | 
| 329 | greg | 2.47 | } else { | 
| 330 | greg | 2.49 | if ("$spec" eq "Visible") { | 
| 331 |  |  | $cmd = "rcalc -if3 -e 'Omega:PI/($ns*$ns)' " . | 
| 332 |  |  | q{-e '$1=(0.265*$1+0.670*$2+0.065*$3)/Omega'}; | 
| 333 |  |  | } elsif ("$spec" eq "CIE-X") { | 
| 334 |  |  | $cmd = "rcalc -if3 -e 'Omega:PI/($ns*$ns)' " . | 
| 335 |  |  | q{-e '$1=(0.514*$1+0.324*$2+0.162*$3)/Omega'}; | 
| 336 |  |  | } elsif ("$spec" eq "CIE-Z") { | 
| 337 |  |  | $cmd = "rcalc -if3 -e 'Omega:PI/($ns*$ns)' " . | 
| 338 |  |  | q{-e '$1=(0.024*$1+0.123*$2+0.853*$3)/Omega'}; | 
| 339 |  |  | } | 
| 340 | greg | 2.47 | } | 
| 341 | greg | 2.49 | if ($pctcull >= 0) { | 
| 342 |  |  | my $avg = ( "$typ" =~ /^r[fb]/ ) ? " -a" : ""; | 
| 343 |  |  | if ($windoz) { | 
| 344 |  |  | $cmd = "rcollate -ho -oc 1 $src | " . | 
| 345 |  |  | $cmd . | 
| 346 |  |  | " | rttree_reduce$avg -h -fa -t $pctcull -r $tensortree -g $ttlog2"; | 
| 347 |  |  | } else { | 
| 348 |  |  | $cmd .= " -of $src " . | 
| 349 |  |  | "| rttree_reduce$avg -h -ff -t $pctcull -r $tensortree -g $ttlog2"; | 
| 350 |  |  | } | 
| 351 |  |  | # print STDERR "Running: $cmd\n"; | 
| 352 |  |  | system "$cmd > $dest"; | 
| 353 |  |  | die "Failure running rttree_reduce" if ( $? ); | 
| 354 | greg | 2.47 | } else { | 
| 355 | greg | 2.49 | if ($windoz) { | 
| 356 |  |  | $cmd = "rcollate -ho -oc 1 $src | " . $cmd ; | 
| 357 |  |  | } else { | 
| 358 |  |  | $cmd .= " $src"; | 
| 359 |  |  | } | 
| 360 |  |  | open(DATOUT, "> $dest"); | 
| 361 |  |  | print DATOUT "{\n"; | 
| 362 |  |  | close DATOUT; | 
| 363 |  |  | # print STDERR "Running: $cmd\n"; | 
| 364 |  |  | system "$cmd >> $dest"; | 
| 365 |  |  | die "Failure running rcalc" if ( $? ); | 
| 366 |  |  | open(DATOUT, ">> $dest"); | 
| 367 |  |  | for (my $i = ($tensortree==3)*$ns*$ns*$ns/2; $i-- > 0; ) { | 
| 368 |  |  | print DATOUT "0\n"; | 
| 369 |  |  | } | 
| 370 |  |  | print DATOUT "}\n"; | 
| 371 |  |  | close DATOUT; | 
| 372 | greg | 2.47 | } | 
| 373 | greg | 2.49 | if ( "$spec" ne "$curspec" ) { | 
| 374 | greg | 2.51 | $wrapper .= " -s $spec"; | 
| 375 | greg | 2.49 | $curspec = $spec; | 
| 376 | greg | 2.34 | } | 
| 377 | greg | 2.49 | $wrapper .= " -$typ $dest"; | 
| 378 |  |  | }       # end of ttree_comp() | 
| 379 | greg | 2.15 |  | 
| 380 |  |  | #------------- End of do_tree_bsdf() & subroutines -------------# | 
| 381 |  |  |  | 
| 382 |  |  | #+++++++++++++++ Klems matrix BSDF generation +++++++++++++++# | 
| 383 |  |  | sub do_matrix_bsdf { | 
| 384 | greg | 2.49 |  | 
| 385 |  |  | # Run rfluxmtx processes to compute each side | 
| 386 |  |  | do_matrix_dir(0) if ( $doback ); | 
| 387 |  |  | do_matrix_dir(1) if ( $doforw ); | 
| 388 |  |  |  | 
| 389 |  |  | }       # end of sub do_matrix_bsdf() | 
| 390 |  |  |  | 
| 391 |  |  | # Call rfluxmtx and process tensor tree BSDF for the given direction | 
| 392 |  |  | sub do_matrix_dir { | 
| 393 |  |  | my $forw = shift; | 
| 394 |  |  | my $cmd; | 
| 395 |  |  | my $sender = ($bsender,$fsender)[$forw]; | 
| 396 |  |  | $cmd = "$rfluxmtx -fd $sender $receivers -i $octree"; | 
| 397 |  |  | # print STDERR "Starting: $cmd\n"; | 
| 398 |  |  | system $cmd; | 
| 399 |  |  | die "Failure running rfluxmtx" if ( $? ); | 
| 400 |  |  | matrix_out($forw); | 
| 401 |  |  | }       # end of do_matrix_dir() | 
| 402 |  |  |  | 
| 403 |  |  | sub matrix_out { | 
| 404 |  |  | my $forw = shift; | 
| 405 |  |  | my ($refldat,$transdat); | 
| 406 |  |  | if ( $forw ) { | 
| 407 |  |  | $transdat = $facedat; | 
| 408 |  |  | $refldat = $behinddat; | 
| 409 | greg | 2.47 | } else { | 
| 410 | greg | 2.49 | $transdat = $behinddat; | 
| 411 |  |  | $refldat = $facedat; | 
| 412 | greg | 2.47 | } | 
| 413 | greg | 2.49 | # Output transmission | 
| 414 |  |  | my $ttyp = ("tb","tf")[$forw]; | 
| 415 |  |  | matrix_comp($ttyp, "Visible", $transdat, ($tb,$tf)[$forw]); | 
| 416 |  |  | if ( $docolor ) { | 
| 417 |  |  | matrix_comp($ttyp, "CIE-X", $transdat, ($tbx,$tfx)[$forw]); | 
| 418 |  |  | matrix_comp($ttyp, "CIE-Z", $transdat, ($tbz,$tfz)[$forw]); | 
| 419 |  |  | } | 
| 420 |  |  | # Output reflection | 
| 421 |  |  | my $rtyp = ("rb","rf")[$forw]; | 
| 422 |  |  | matrix_comp($rtyp, "Visible", $refldat, ($rb,$rf)[$forw]); | 
| 423 |  |  | if ( $docolor ) { | 
| 424 |  |  | matrix_comp($rtyp, "CIE-X", $refldat, ($rbx,$rfx)[$forw]); | 
| 425 |  |  | matrix_comp($rtyp, "CIE-Z", $refldat, ($rbz,$rfz)[$forw]); | 
| 426 |  |  | } | 
| 427 |  |  | }       # end of matrix_out() | 
| 428 |  |  |  | 
| 429 |  |  | # Transpose matrix component data and save to file | 
| 430 |  |  | sub matrix_comp { | 
| 431 |  |  | my $typ = shift; | 
| 432 |  |  | my $spec = shift; | 
| 433 |  |  | my $src = shift; | 
| 434 |  |  | my $dest = shift; | 
| 435 |  |  | my $cmd = "rmtxop -fa -t"; | 
| 436 |  |  | if ("$spec" eq "Visible") { | 
| 437 |  |  | $cmd .= " -c 0.265 0.670 0.065"; | 
| 438 |  |  | } elsif ("$spec" eq "CIE-X") { | 
| 439 |  |  | $cmd .= " -c 0.514 0.324 0.162"; | 
| 440 |  |  | } elsif ("$spec" eq "CIE-Z") { | 
| 441 |  |  | $cmd .= " -c 0.024 0.123 0.853"; | 
| 442 |  |  | } | 
| 443 | greg | 2.50 | $cmd .= " $src | rcollate -ho"; | 
| 444 | greg | 2.49 | # print STDERR "Running: $cmd\n"; | 
| 445 |  |  | system "$cmd > $dest"; | 
| 446 |  |  | die "Failure running rttree_reduce" if ( $? ); | 
| 447 |  |  | if ( "$spec" ne "$curspec" ) { | 
| 448 | greg | 2.51 | $wrapper .= " -s $spec"; | 
| 449 | greg | 2.49 | $curspec = $spec; | 
| 450 | greg | 2.47 | } | 
| 451 | greg | 2.49 | $wrapper .= " -$typ $dest"; | 
| 452 |  |  | }       # end of matrix_comp() | 
| 453 | greg | 2.47 |  | 
| 454 | greg | 2.49 | #------------- End of do_matrix_bsdf() & subroutines --------------# |