| 6 |  | #       G. Ward | 
| 7 |  | # | 
| 8 |  | use strict; | 
| 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][-r \"ropts\"][-dim xmin xmax ymin ymax zmin zmax][{+|-}f][{+|-}b][{+|-}mgf][{+|-}geom] [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][{+|-}a][{+|-}f][{+|-}b][{+|-}mgf][{+|-}geom units] [input ..]\n"; | 
| 13 |  | exit 1; | 
| 14 |  | } | 
| 15 | < | my $td = mkdtemp("/tmp/genBSDF.XXXXXX"); | 
| 16 | < | chomp $td; | 
| 17 | < | my $nsamp = 1000; | 
| 18 | < | my $rtargs = "-w -ab 5 -ad 700 -lw 3e-6"; | 
| 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 | > | 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 | > | $recovery = 0; | 
| 25 | > | if (open(MYPH, "< $td/phase.txt")) { | 
| 26 | > | while (<MYPH>) { | 
| 27 | > | chomp($recovery = $_); | 
| 28 | > | } | 
| 29 | > | close MYPH; | 
| 30 | > | } | 
| 31 | > | } elsif ($windoz) { | 
| 32 | > | my $tmploc = `echo \%TMP\%`; | 
| 33 | > | chomp $tmploc; | 
| 34 | > | $td = mkdtemp("$tmploc\\genBSDF.XXXXXX"); | 
| 35 | > | } else { | 
| 36 | > | $td = mkdtemp("/tmp/genBSDF.XXXXXX"); | 
| 37 | > | chomp $td; | 
| 38 | > | } | 
| 39 | > | if ($windoz) { | 
| 40 | > | $radscn = "$td\\device.rad"; | 
| 41 | > | $mgfscn = "$td\\device.mgf"; | 
| 42 | > | $octree = "$td\\device.oct"; | 
| 43 | > | $fsender = "$td\\fsender.rad"; | 
| 44 | > | $bsender = "$td\\bsender.rad"; | 
| 45 | > | $receivers = "$td\\receivers.rad"; | 
| 46 | > | $facedat = "$td\\face.dat"; | 
| 47 | > | $behinddat = "$td\\behind.dat"; | 
| 48 | > | $tf = "$td\\tf.dat"; | 
| 49 | > | $rf = "$td\\rf.dat"; | 
| 50 | > | $tb = "$td\\tb.dat"; | 
| 51 | > | $rb = "$td\\rb.dat"; | 
| 52 | > | $tfx = "$td\\tfx.dat"; | 
| 53 | > | $rfx = "$td\\rfx.dat"; | 
| 54 | > | $tbx = "$td\\tbx.dat"; | 
| 55 | > | $rbx = "$td\\rbx.dat"; | 
| 56 | > | $tfz = "$td\\tfz.dat"; | 
| 57 | > | $rfz = "$td\\rfz.dat"; | 
| 58 | > | $tbz = "$td\\tbz.dat"; | 
| 59 | > | $rbz = "$td\\rbz.dat"; | 
| 60 | > | $rmtmp = "rd /S /Q $td"; | 
| 61 | > | } else { | 
| 62 | > | $radscn = "$td/device.rad"; | 
| 63 | > | $mgfscn = "$td/device.mgf"; | 
| 64 | > | $octree = "$td/device.oct"; | 
| 65 | > | $fsender = "$td/fsender.rad"; | 
| 66 | > | $bsender = "$td/bsender.rad"; | 
| 67 | > | $receivers = "$td/receivers.rad"; | 
| 68 | > | $facedat = "$td/face.dat"; | 
| 69 | > | $behinddat = "$td/behind.dat"; | 
| 70 | > | $tf = "$td/tf.dat"; | 
| 71 | > | $rf = "$td/rf.dat"; | 
| 72 | > | $tb = "$td/tb.dat"; | 
| 73 | > | $rb = "$td/rb.dat"; | 
| 74 | > | $tfx = "$td/tfx.dat"; | 
| 75 | > | $rfx = "$td/rfx.dat"; | 
| 76 | > | $tbx = "$td/tbx.dat"; | 
| 77 | > | $rbx = "$td/rbx.dat"; | 
| 78 | > | $tfz = "$td/tfz.dat"; | 
| 79 | > | $rfz = "$td/rfz.dat"; | 
| 80 | > | $tbz = "$td/tbz.dat"; | 
| 81 | > | $rbz = "$td/rbz.dat"; | 
| 82 | > | $rmtmp = "rm -rf $td"; | 
| 83 | > | } | 
| 84 | > | my @savedARGV = @ARGV; | 
| 85 | > | my $rfluxmtx = "rfluxmtx -ab 5 -ad 700 -lw 3e-6 -w-"; | 
| 86 | > | my $wrapper = "wrapBSDF"; | 
| 87 | > | my $tensortree = 0; | 
| 88 | > | my $ttlog2 = 4; | 
| 89 | > | my $dorecip = 1; | 
| 90 | > | my $nsamp = 2000; | 
| 91 |  | my $mgfin = 0; | 
| 92 |  | my $geout = 1; | 
| 93 |  | my $nproc = 1; | 
| 94 | + | my $docolor = 0; | 
| 95 |  | my $doforw = 0; | 
| 96 |  | my $doback = 1; | 
| 97 | + | my $pctcull = 90; | 
| 98 | + | my $gunit = "meter"; | 
| 99 | + | my $curspec = "Visible"; | 
| 100 |  | my @dim; | 
| 101 |  | # Get options | 
| 102 |  | while ($#ARGV >= 0) { | 
| 103 |  | if ("$ARGV[0]" =~ /^[-+]m/) { | 
| 104 |  | $mgfin = ("$ARGV[0]" =~ /^\+/); | 
| 105 |  | } elsif ("$ARGV[0]" eq "-r") { | 
| 106 | < | $rtargs = "$rtargs $ARGV[1]"; | 
| 106 | > | $rfluxmtx .= " $ARGV[1]"; | 
| 107 |  | shift @ARGV; | 
| 108 |  | } elsif ("$ARGV[0]" =~ /^[-+]g/) { | 
| 109 |  | $geout = ("$ARGV[0]" =~ /^\+/); | 
| 110 | + | $gunit = $ARGV[1]; | 
| 111 | + | if ($gunit !~ /^(?i)(meter|foot|inch|centimeter|millimeter)$/) { | 
| 112 | + | die "Illegal geometry unit '$gunit': must be meter, foot, inch, centimeter, or millimeter\n"; | 
| 113 | + | } | 
| 114 | + | shift @ARGV; | 
| 115 | + | } elsif ("$ARGV[0]" =~ /^[-+]C/) { | 
| 116 | + | $docolor = ("$ARGV[0]" =~ /^\+/); | 
| 117 | + | } elsif ("$ARGV[0]" =~ /^[-+]a/) { | 
| 118 | + | $dorecip = ("$ARGV[0]" =~ /^\+/); | 
| 119 |  | } elsif ("$ARGV[0]" =~ /^[-+]f/) { | 
| 120 |  | $doforw = ("$ARGV[0]" =~ /^\+/); | 
| 121 |  | } elsif ("$ARGV[0]" =~ /^[-+]b/) { | 
| 122 |  | $doback = ("$ARGV[0]" =~ /^\+/); | 
| 123 | + | } elsif ("$ARGV[0]" eq "-t") { | 
| 124 | + | # Use value < 0 for rttree_reduce bypass | 
| 125 | + | $pctcull = $ARGV[1]; | 
| 126 | + | if ($pctcull >= 100) { | 
| 127 | + | die "Illegal -t culling percentage, must be < 100\n"; | 
| 128 | + | } | 
| 129 | + | shift @ARGV; | 
| 130 | + | } elsif ("$ARGV[0]" =~ /^-t[34]$/) { | 
| 131 | + | $tensortree = substr($ARGV[0], 2, 1); | 
| 132 | + | $ttlog2 = $ARGV[1]; | 
| 133 | + | shift @ARGV; | 
| 134 | + | } elsif ("$ARGV[0]" eq "-s") { | 
| 135 | + | $wrapper .= " -f \"$ARGV[1]\""; | 
| 136 | + | shift @ARGV; | 
| 137 | + | } elsif ("$ARGV[0]" eq "-W") { | 
| 138 | + | $wrapper .= " -W"; | 
| 139 |  | } elsif ("$ARGV[0]" eq "-c") { | 
| 140 |  | $nsamp = $ARGV[1]; | 
| 141 |  | shift @ARGV; | 
| 154 |  | shift @ARGV; | 
| 155 |  | } | 
| 156 |  | # Check that we're actually being asked to do something | 
| 157 | < | die "Must have at least one of +forward or +backward" if (!$doforw && !$doback); | 
| 158 | < | # Get scene description and dimensions | 
| 159 | < | my $radscn = "$td/device.rad"; | 
| 160 | < | my $mgfscn = "$td/device.mgf"; | 
| 161 | < | my $octree = "$td/device.oct"; | 
| 162 | < | if ( $mgfin ) { | 
| 163 | < | system "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 | < | die "Could not load MGF input\n" if ( $? ); | 
| 165 | < | system "mgf2rad $mgfscn > $radscn"; | 
| 166 | < | } else { | 
| 167 | < | system "xform -e @ARGV > $radscn"; | 
| 168 | < | die "Could not load Radiance input\n" if ( $? ); | 
| 169 | < | system "rad2mgf $radscn > $mgfscn" if ( $geout ); | 
| 157 | > | die "Must have at least one of +forward or +backward\n" if (!$doforw && !$doback); | 
| 158 | > | $wrapper .= $tensortree ? " -a t$tensortree" : " -a kf -c"; | 
| 159 | > | $wrapper .= " -u $gunit"; | 
| 160 | > | if ( !defined $recovery ) { | 
| 161 | > | # Issue warning for unhandled reciprocity case | 
| 162 | > | print STDERR "Warning: recommend both +forward and +backward with -t3\n" if | 
| 163 | > | ($tensortree==3 && !($doforw && $doback)); | 
| 164 | > | # Get scene description | 
| 165 | > | if ( $mgfin ) { | 
| 166 | > | system "mgf2rad -s @ARGV > $radscn"; | 
| 167 | > | die "Could not load MGF input\n" if ( $? ); | 
| 168 | > | } else { | 
| 169 | > | system "xform -e @ARGV > $radscn"; | 
| 170 | > | die "Could not load Radiance input\n" if ( $? ); | 
| 171 | > | } | 
| 172 |  | } | 
| 173 | < | if ($#dim != 5) { | 
| 174 | < | @dim = split ' ', `getbbox -h $radscn`; | 
| 173 | > | if ( $#dim != 5 ) { | 
| 174 | > | @dim = split ' ', `getbbox -h -w $radscn`; | 
| 175 |  | } | 
| 176 | < | print STDERR "Warning: Device extends into room\n" if ($dim[5] > 1e-5); | 
| 177 | < | # Add receiver surfaces (rectangular) | 
| 178 | < | my $fmodnm="receiver_face"; | 
| 179 | < | my $bmodnm="receiver_behind"; | 
| 180 | < | open(RADSCN, ">> $radscn"); | 
| 77 | < | print RADSCN "void glow $fmodnm\n0\n0\n4 1 1 1 0\n\n"; | 
| 78 | < | print RADSCN "$fmodnm source f_receiver\n0\n0\n4 0 0 1 180\n"; | 
| 79 | < | print RADSCN "void glow $bmodnm\n0\n0\n4 1 1 1 0\n\n"; | 
| 80 | < | print RADSCN "$bmodnm source b_receiver\n0\n0\n4 0 0 -1 180\n"; | 
| 81 | < | close RADSCN; | 
| 82 | < | # Generate octree | 
| 83 | < | system "oconv -w $radscn > $octree"; | 
| 84 | < | die "Could not compile scene\n" if ( $? ); | 
| 85 | < | # Set up sampling of interior portal | 
| 86 | < | # Kbin to produce incident direction in full Klems basis with (x1,x2) randoms | 
| 87 | < | my $tcal = ' | 
| 88 | < | DEGREE : PI/180; | 
| 89 | < | sq(x) : x*x; | 
| 90 | < | Kpola(r) : select(r+1, -5, 5, 15, 25, 35, 45, 55, 65, 75, 90); | 
| 91 | < | Knaz(r) : select(r, 1, 8, 16, 20, 24, 24, 24, 16, 12); | 
| 92 | < | Kaccum(r) : if(r-.5, Knaz(r) + Kaccum(r-1), 0); | 
| 93 | < | Kmax : Kaccum(Knaz(0)); | 
| 94 | < | Kfindrow(r, rem) : if(rem-Knaz(r)+.5, Kfindrow(r+1, rem-Knaz(r)), r); | 
| 95 | < | Krow = if(Kbin-(Kmax-.5), 0, Kfindrow(1, Kbin)); | 
| 96 | < | Kcol = Kbin - Kaccum(Krow-1); | 
| 97 | < | Kazi = 360*DEGREE * (Kcol + (.5 - x2)) / Knaz(Krow); | 
| 98 | < | Kpol = DEGREE * (x1*Kpola(Krow) + (1-x1)*Kpola(Krow-1)); | 
| 99 | < | sin_kpol = sin(Kpol); | 
| 100 | < | Dx = cos(Kazi)*sin_kpol; | 
| 101 | < | Dy = sin(Kazi)*sin_kpol; | 
| 102 | < | Dz = sqrt(1 - sin_kpol*sin_kpol); | 
| 103 | < | KprojOmega = PI * if(Kbin-.5, | 
| 104 | < | (sq(cos(Kpola(Krow-1)*DEGREE)) - sq(cos(Kpola(Krow)*DEGREE)))/Knaz(Krow), | 
| 105 | < | 1 - sq(cos(Kpola(1)*DEGREE))); | 
| 106 | < | '; | 
| 107 | < | # Compute Klems bin from exiting ray direction (forward or backward) | 
| 108 | < | my $kcal = ' | 
| 109 | < | DEGREE : PI/180; | 
| 110 | < | abs(x) : if(x, x, -x); | 
| 111 | < | Acos(x) : 1/DEGREE * if(x-1, 0, if(-1-x, 0, acos(x))); | 
| 112 | < | posangle(a) : if(-a, a + 2*PI, a); | 
| 113 | < | Atan2(y,x) : 1/DEGREE * posangle(atan2(y,x)); | 
| 114 | < | kpola(r) : select(r, 5, 15, 25, 35, 45, 55, 65, 75, 90); | 
| 115 | < | knaz(r) : select(r, 1, 8, 16, 20, 24, 24, 24, 16, 12); | 
| 116 | < | kaccum(r) : if(r-.5, knaz(r) + kaccum(r-1), 0); | 
| 117 | < | kfindrow(r, pol) : if(r-kpola(0)+.5, r, | 
| 118 | < | if(pol-kpola(r), kfindrow(r+1, pol), r) ); | 
| 119 | < | kazn(azi,inc) : if((360-.5*inc)-azi, floor((azi+.5*inc)/inc), 0); | 
| 120 | < | kbin2(pol,azi) = select(kfindrow(1, pol), | 
| 121 | < | kazn(azi,360/knaz(1)), | 
| 122 | < | kaccum(1) + kazn(azi,360/knaz(2)), | 
| 123 | < | kaccum(2) + kazn(azi,360/knaz(3)), | 
| 124 | < | kaccum(3) + kazn(azi,360/knaz(4)), | 
| 125 | < | kaccum(4) + kazn(azi,360/knaz(5)), | 
| 126 | < | kaccum(5) + kazn(azi,360/knaz(6)), | 
| 127 | < | kaccum(6) + kazn(azi,360/knaz(7)), | 
| 128 | < | kaccum(7) + kazn(azi,360/knaz(8)), | 
| 129 | < | kaccum(8) + kazn(azi,360/knaz(9)) | 
| 130 | < | ); | 
| 131 | < | kbin = kbin2(Acos(abs(Dz)),Atan2(Dy,Dx)); | 
| 132 | < | '; | 
| 133 | < | my $ndiv = 145; | 
| 134 | < | my $nx = int(sqrt($nsamp*($dim[1]-$dim[0])/($dim[3]-$dim[2])) + .5); | 
| 135 | < | my $ny = int($nsamp/$nx + .5); | 
| 136 | < | $nsamp = $nx * $ny; | 
| 137 | < | # Compute scattering data using rtcontrib | 
| 138 | < | my @tfarr; | 
| 139 | < | my @rfarr; | 
| 140 | < | my @tbarr; | 
| 141 | < | my @rbarr; | 
| 142 | < | my $cmd; | 
| 143 | < | my $rtcmd = "rtcontrib -h -ff -fo -n $nproc -c $nsamp " . | 
| 144 | < | "-e '$kcal' -b kbin -bn $ndiv " . | 
| 145 | < | "-o '$td/%s.flt' -m $fmodnm -m $bmodnm $rtargs $octree"; | 
| 146 | < | my $rccmd = "rcalc -e '$tcal' " . | 
| 147 | < | "-e 'mod(n,d):n-floor(n/d)*d' -e 'Kbin=mod(recno-.999,$ndiv)' " . | 
| 148 | < | q{-if3 -e '$1=(0.265*$1+0.670*$2+0.065*$3)/KprojOmega'}; | 
| 149 | < | if ( $doforw ) { | 
| 150 | < | $cmd = "cnt $ndiv $ny $nx | rcalc -of -e '$tcal' " . | 
| 151 | < | "-e 'xp=(\$3+rand(.12*recno+288))*(($dim[1]-$dim[0])/$nx)+$dim[0]' " . | 
| 152 | < | "-e 'yp=(\$2+rand(.37*recno-44))*(($dim[3]-$dim[2])/$ny)+$dim[2]' " . | 
| 153 | < | "-e 'zp:$dim[4]' " . | 
| 154 | < | q{-e 'Kbin=$1;x1=rand(2.75*recno+3.1);x2=rand(-2.01*recno-3.37)' } . | 
| 155 | < | q{-e '$1=xp-Dx;$2=yp-Dy;$3=zp-Dz;$4=Dx;$5=Dy;$6=Dz' } . | 
| 156 | < | "| $rtcmd"; | 
| 157 | < | system "$cmd" || die "Failure running: $cmd\n"; | 
| 158 | < | @tfarr = `$rccmd $td/$fmodnm.flt`; | 
| 159 | < | die "Failure running: $rccmd $td/$fmodnm.flt\n" if ( $? ); | 
| 160 | < | @rfarr = `$rccmd $td/$bmodnm.flt`; | 
| 161 | < | die "Failure running: $rccmd $td/$bmodnm.flt\n" if ( $? ); | 
| 176 | > | die "Device entirely inside room!\n" if ( $dim[4] >= 0 ); | 
| 177 | > | if ( $dim[5] > 1e-5 ) { | 
| 178 | > | print STDERR "Warning: Device extends into room\n"; | 
| 179 | > | } elsif ( $dim[5]*$dim[5] > .01*($dim[1]-$dim[0])*($dim[3]-$dim[2]) ) { | 
| 180 | > | print STDERR "Warning: Device far behind Z==0 plane\n"; | 
| 181 |  | } | 
| 182 | < | if ( $doback ) { | 
| 183 | < | $cmd = "cnt $ndiv $ny $nx | rcalc -of -e '$tcal' " . | 
| 184 | < | "-e 'xp=(\$3+rand(.35*recno-15))*(($dim[1]-$dim[0])/$nx)+$dim[0]' " . | 
| 185 | < | "-e 'yp=(\$2+rand(.86*recno+11))*(($dim[3]-$dim[2])/$ny)+$dim[2]' " . | 
| 186 | < | "-e 'zp:$dim[5]' " . | 
| 187 | < | q{-e 'Kbin=$1;x1=rand(1.21*recno+2.75);x2=rand(-3.55*recno-7.57)' } . | 
| 188 | < | q{-e '$1=xp-Dx;$2=yp-Dy;$3=zp+Dz;$4=Dx;$5=Dy;$6=-Dz' } . | 
| 189 | < | "| $rtcmd"; | 
| 190 | < | system "$cmd" || die "Failure running: $cmd\n"; | 
| 191 | < | @tbarr = `$rccmd $td/$bmodnm.flt`; | 
| 192 | < | die "Failure running: $rccmd $td/$bmodnm.flt\n" if ( $? ); | 
| 193 | < | @rbarr = `$rccmd $td/$fmodnm.flt`; | 
| 194 | < | die "Failure running: $rccmd $td/$fmodnm.flt\n" if ( $? ); | 
| 195 | < | } | 
| 196 | < | # Output XML prologue | 
| 197 | < | print | 
| 198 | < | '<?xml version="1.0" encoding="UTF-8"?> | 
| 199 | < | <WindowElement xmlns="http://windows.lbl.gov" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://windows.lbl.gov/BSDF-v1.4.xsd"> | 
| 181 | < | <WindowElementType>System</WindowElementType> | 
| 182 | < | <Optical> | 
| 183 | < | <Layer> | 
| 184 | < | <Material> | 
| 185 | < | <Name>Name</Name> | 
| 186 | < | <Manufacturer>Manufacturer</Manufacturer> | 
| 187 | < | '; | 
| 188 | < | printf "\t\t\t<Thickness unit=\"Meter\">%.3f</Thickness>\n", $dim[5] - $dim[4]; | 
| 189 | < | printf "\t\t\t<Width unit=\"Meter\">%.3f</Width>\n", $dim[1] - $dim[0]; | 
| 190 | < | printf "\t\t\t<Height unit=\"Meter\">%.3f</Height>\n", $dim[3] - $dim[2]; | 
| 191 | < | print "\t\t\t<DeviceType>Integral</DeviceType>\n"; | 
| 192 | < | # Output MGF description if requested | 
| 193 | < | if ( $geout ) { | 
| 194 | < | print "\t\t\t<Geometry format=\"MGF\" unit=\"Meter\">\n"; | 
| 195 | < | printf "xf -t %.6f %.6f 0\n", -($dim[0]+$dim[1])/2, -($dim[2]+$dim[3])/2; | 
| 196 | < | system "cat $mgfscn"; | 
| 197 | < | print "xf\n"; | 
| 198 | < | print "\t\t\t</Geometry>\n"; | 
| 199 | < | } | 
| 200 | < | print '                 </Material> | 
| 201 | < | <DataDefinition> | 
| 202 | < | <IncidentDataStructure>Columns</IncidentDataStructure> | 
| 203 | < | <AngleBasis> | 
| 204 | < | <AngleBasisName>LBNL/Klems Full</AngleBasisName> | 
| 205 | < | <AngleBasisBlock> | 
| 206 | < | <Theta>0</Theta> | 
| 207 | < | <nPhis>1</nPhis> | 
| 208 | < | <ThetaBounds> | 
| 209 | < | <LowerTheta>0</LowerTheta> | 
| 210 | < | <UpperTheta>5</UpperTheta> | 
| 211 | < | </ThetaBounds> | 
| 212 | < | </AngleBasisBlock> | 
| 213 | < | <AngleBasisBlock> | 
| 214 | < | <Theta>10</Theta> | 
| 215 | < | <nPhis>8</nPhis> | 
| 216 | < | <ThetaBounds> | 
| 217 | < | <LowerTheta>5</LowerTheta> | 
| 218 | < | <UpperTheta>15</UpperTheta> | 
| 219 | < | </ThetaBounds> | 
| 220 | < | </AngleBasisBlock> | 
| 221 | < | <AngleBasisBlock> | 
| 222 | < | <Theta>20</Theta> | 
| 223 | < | <nPhis>16</nPhis> | 
| 224 | < | <ThetaBounds> | 
| 225 | < | <LowerTheta>15</LowerTheta> | 
| 226 | < | <UpperTheta>25</UpperTheta> | 
| 227 | < | </ThetaBounds> | 
| 228 | < | </AngleBasisBlock> | 
| 229 | < | <AngleBasisBlock> | 
| 230 | < | <Theta>30</Theta> | 
| 231 | < | <nPhis>20</nPhis> | 
| 232 | < | <ThetaBounds> | 
| 233 | < | <LowerTheta>25</LowerTheta> | 
| 234 | < | <UpperTheta>35</UpperTheta> | 
| 235 | < | </ThetaBounds> | 
| 236 | < | </AngleBasisBlock> | 
| 237 | < | <AngleBasisBlock> | 
| 238 | < | <Theta>40</Theta> | 
| 239 | < | <nPhis>24</nPhis> | 
| 240 | < | <ThetaBounds> | 
| 241 | < | <LowerTheta>35</LowerTheta> | 
| 242 | < | <UpperTheta>45</UpperTheta> | 
| 243 | < | </ThetaBounds> | 
| 244 | < | </AngleBasisBlock> | 
| 245 | < | <AngleBasisBlock> | 
| 246 | < | <Theta>50</Theta> | 
| 247 | < | <nPhis>24</nPhis> | 
| 248 | < | <ThetaBounds> | 
| 249 | < | <LowerTheta>45</LowerTheta> | 
| 250 | < | <UpperTheta>55</UpperTheta> | 
| 251 | < | </ThetaBounds> | 
| 252 | < | </AngleBasisBlock> | 
| 253 | < | <AngleBasisBlock> | 
| 254 | < | <Theta>60</Theta> | 
| 255 | < | <nPhis>24</nPhis> | 
| 256 | < | <ThetaBounds> | 
| 257 | < | <LowerTheta>55</LowerTheta> | 
| 258 | < | <UpperTheta>65</UpperTheta> | 
| 259 | < | </ThetaBounds> | 
| 260 | < | </AngleBasisBlock> | 
| 261 | < | <AngleBasisBlock> | 
| 262 | < | <Theta>70</Theta> | 
| 263 | < | <nPhis>16</nPhis> | 
| 264 | < | <ThetaBounds> | 
| 265 | < | <LowerTheta>65</LowerTheta> | 
| 266 | < | <UpperTheta>75</UpperTheta> | 
| 267 | < | </ThetaBounds> | 
| 268 | < | </AngleBasisBlock> | 
| 269 | < | <AngleBasisBlock> | 
| 270 | < | <Theta>82.5</Theta> | 
| 271 | < | <nPhis>12</nPhis> | 
| 272 | < | <ThetaBounds> | 
| 273 | < | <LowerTheta>75</LowerTheta> | 
| 274 | < | <UpperTheta>90</UpperTheta> | 
| 275 | < | </ThetaBounds> | 
| 276 | < | </AngleBasisBlock> | 
| 277 | < | </AngleBasis> | 
| 278 | < | </DataDefinition> | 
| 279 | < | '; | 
| 280 | < | if ( $doforw ) { | 
| 281 | < | print '         <WavelengthData> | 
| 282 | < | <LayerNumber>System</LayerNumber> | 
| 283 | < | <Wavelength unit="Integral">Visible</Wavelength> | 
| 284 | < | <SourceSpectrum>CIE Illuminant D65 1nm.ssp</SourceSpectrum> | 
| 285 | < | <DetectorSpectrum>ASTM E308 1931 Y.dsp</DetectorSpectrum> | 
| 286 | < | <WavelengthDataBlock> | 
| 287 | < | <WavelengthDataDirection>Transmission Front</WavelengthDataDirection> | 
| 288 | < | <ColumnAngleBasis>LBNL/Klems Full</ColumnAngleBasis> | 
| 289 | < | <RowAngleBasis>LBNL/Klems Full</RowAngleBasis> | 
| 290 | < | <ScatteringDataType>BTDF</ScatteringDataType> | 
| 291 | < | <ScatteringData> | 
| 292 | < | '; | 
| 293 | < | # Output front transmission (transposed order) | 
| 294 | < | for (my $od = 0; $od < $ndiv; $od++) { | 
| 295 | < | for (my $id = 0; $id < $ndiv; $id++) { | 
| 296 | < | print $tfarr[$ndiv*$id + $od]; | 
| 182 | > | # Assume Zmax==0 to derive thickness so pkgBSDF will work | 
| 183 | > | $wrapper .= ' -f "t=' . (-$dim[4]) . ';w=' . ($dim[1] - $dim[0]) . | 
| 184 | > | ';h=' . ($dim[3] - $dim[2]) . '"'; | 
| 185 | > | $wrapper .= " -g $mgfscn" if ( $geout ); | 
| 186 | > | # Calculate CIE (u',v') from Radiance RGB: | 
| 187 | > | my $CIEuv =     'den=Xi+15*Yi+3*Zi;' . | 
| 188 | > | 'uprime=if(Yi,4*Xi/den,4/19);' . | 
| 189 | > | 'vprime=if(Yi,9*Yi/den,9/19);' ; | 
| 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; | 
| 195 | > | $rfluxmtx .= " -n $nproc -c $nsamp"; | 
| 196 | > | if ( !defined $recovery ) { | 
| 197 | > | open(MYAVH, "> $td/savedARGV.txt"); | 
| 198 | > | foreach (@savedARGV) { | 
| 199 | > | print MYAVH "$_\n"; | 
| 200 |  | } | 
| 201 | < | print "\n"; | 
| 202 | < | } | 
| 203 | < | print | 
| 204 | < | '               </ScatteringData> | 
| 205 | < | </WavelengthDataBlock> | 
| 206 | < | </WavelengthData> | 
| 207 | < | <WavelengthData> | 
| 208 | < | <LayerNumber>System</LayerNumber> | 
| 209 | < | <Wavelength unit="Integral">Visible</Wavelength> | 
| 210 | < | <SourceSpectrum>CIE Illuminant D65 1nm.ssp</SourceSpectrum> | 
| 211 | < | <DetectorSpectrum>ASTM E308 1931 Y.dsp</DetectorSpectrum> | 
| 212 | < | <WavelengthDataBlock> | 
| 213 | < | <WavelengthDataDirection>Reflection Front</WavelengthDataDirection> | 
| 214 | < | <ColumnAngleBasis>LBNL/Klems Full</ColumnAngleBasis> | 
| 215 | < | <RowAngleBasis>LBNL/Klems Full</RowAngleBasis> | 
| 216 | < | <ScatteringDataType>BRDF</ScatteringDataType> | 
| 217 | < | <ScatteringData> | 
| 218 | < | '; | 
| 316 | < | # Output front reflection (transposed order) | 
| 317 | < | for (my $od = 0; $od < $ndiv; $od++) { | 
| 318 | < | for (my $id = 0; $id < $ndiv; $id++) { | 
| 319 | < | print $rfarr[$ndiv*$id + $od]; | 
| 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 | > | die "+mgf requires input file with +geom\n" if ($#ARGV < 0); | 
| 212 | > | 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}; | 
| 213 | > | } else { | 
| 214 | > | system "rad2mgf $radscn >> $mgfscn"; | 
| 215 | > | } | 
| 216 | > | open(MGFSCN, ">> $mgfscn"); | 
| 217 | > | print MGFSCN "xf\n"; | 
| 218 | > | close MGFSCN; | 
| 219 |  | } | 
| 220 | < | print "\n"; | 
| 220 | > | # Create receiver & sender surfaces (rectangular) | 
| 221 | > | open(RADSCN, "> $receivers"); | 
| 222 | > | print RADSCN '#@rfluxmtx ' . ($tensortree ? "h=-sc$ns\n" : "h=-kf\n"); | 
| 223 | > | print RADSCN '#@rfluxmtx ' . "u=-Y o=$facedat\n\n"; | 
| 224 | > | print RADSCN "void glow receiver_face\n0\n0\n4 1 1 1 0\n\n"; | 
| 225 | > | print RADSCN "receiver_face source f_receiver\n0\n0\n4 0 0 1 180\n\n"; | 
| 226 | > | print RADSCN '#@rfluxmtx ' . ($tensortree ? "h=+sc$ns\n" : "h=+kf\n"); | 
| 227 | > | print RADSCN '#@rfluxmtx ' . "u=-Y o=$behinddat\n\n"; | 
| 228 | > | print RADSCN "void glow receiver_behind\n0\n0\n4 1 1 1 0\n\n"; | 
| 229 | > | print RADSCN "receiver_behind source b_receiver\n0\n0\n4 0 0 -1 180\n"; | 
| 230 | > | close RADSCN; | 
| 231 | > | # Prepare sender surfaces | 
| 232 | > | if ( $tensortree != 3 ) {       # Isotropic tensor tree is exception | 
| 233 | > | open (RADSCN, "> $fsender"); | 
| 234 | > | print RADSCN '#@rfluxmtx u=-Y ' . ($tensortree ? "h=-sc$ns\n\n" : "h=-kf\n\n"); | 
| 235 | > | print RADSCN "void polygon fwd_sender\n0\n0\n12\n"; | 
| 236 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[0], $dim[2], $dim[4]-$FEPS; | 
| 237 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[0], $dim[3], $dim[4]-$FEPS; | 
| 238 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[1], $dim[3], $dim[4]-$FEPS; | 
| 239 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[1], $dim[2], $dim[4]-$FEPS; | 
| 240 | > | close RADSCN; | 
| 241 | > | open (RADSCN, "> $bsender"); | 
| 242 | > | print RADSCN '#@rfluxmtx u=-Y ' . ($tensortree ? "h=+sc$ns\n\n" : "h=+kf\n\n"); | 
| 243 | > | print RADSCN "void polygon bwd_sender\n0\n0\n12\n"; | 
| 244 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[0], $dim[2], $dim[5]+$FEPS; | 
| 245 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[1], $dim[2], $dim[5]+$FEPS; | 
| 246 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[1], $dim[3], $dim[5]+$FEPS; | 
| 247 | > | printf RADSCN "\t%e\t%e\t%e\n", $dim[0], $dim[3], $dim[5]+$FEPS; | 
| 248 | > | close RADSCN; | 
| 249 | > | } | 
| 250 | > | print STDERR "Recover using: $0 -recover $td\n"; | 
| 251 |  | } | 
| 252 | < | print | 
| 253 | < | '               </ScatteringData> | 
| 254 | < | </WavelengthDataBlock> | 
| 255 | < | </WavelengthData> | 
| 256 | < | '; | 
| 252 | > | $curphase = 0; | 
| 253 | > | # Create data segments (all the work happens here) | 
| 254 | > | if ( $tensortree ) { | 
| 255 | > | do_tree_bsdf(); | 
| 256 | > | } else { | 
| 257 | > | do_matrix_bsdf(); | 
| 258 |  | } | 
| 259 | < | if ( $doback ) { | 
| 260 | < | print '         <WavelengthData> | 
| 261 | < | <LayerNumber>System</LayerNumber> | 
| 262 | < | <Wavelength unit="Integral">Visible</Wavelength> | 
| 263 | < | <SourceSpectrum>CIE Illuminant D65 1nm.ssp</SourceSpectrum> | 
| 264 | < | <DetectorSpectrum>ASTM E308 1931 Y.dsp</DetectorSpectrum> | 
| 265 | < | <WavelengthDataBlock> | 
| 266 | < | <WavelengthDataDirection>Transmission Back</WavelengthDataDirection> | 
| 267 | < | <ColumnAngleBasis>LBNL/Klems Full</ColumnAngleBasis> | 
| 268 | < | <RowAngleBasis>LBNL/Klems Full</RowAngleBasis> | 
| 269 | < | <ScatteringDataType>BTDF</ScatteringDataType> | 
| 270 | < | <ScatteringData> | 
| 271 | < | '; | 
| 272 | < | # Output back transmission (transposed order) | 
| 273 | < | for (my $od = 0; $od < $ndiv; $od++) { | 
| 344 | < | for (my $id = 0; $id < $ndiv; $id++) { | 
| 345 | < | print $tbarr[$ndiv*$id + $od]; | 
| 259 | > | # Output XML | 
| 260 | > | # print STDERR "Running: $wrapper\n"; | 
| 261 | > | system "$wrapper -C \"Created by: genBSDF @savedARGV\""; | 
| 262 | > | die "Could not wrap BSDF data\n" if ( $? ); | 
| 263 | > | # Clean up temporary files and exit | 
| 264 | > | exec $rmtmp; | 
| 265 | > |  | 
| 266 | > | #============== End of main program segment ==============# | 
| 267 | > |  | 
| 268 | > | # Function to determine if next phase should be skipped or recovered | 
| 269 | > | sub do_phase { | 
| 270 | > | $curphase++; | 
| 271 | > | if ( defined $recovery ) { | 
| 272 | > | if ( $recovery > $curphase ) { return 0; } | 
| 273 | > | if ( $recovery == $curphase ) { return -1; } | 
| 274 |  | } | 
| 275 | < | print "\n"; | 
| 275 | > | open(MYPH, ">> $td/phase.txt"); | 
| 276 | > | print MYPH "$curphase\n"; | 
| 277 | > | close MYPH; | 
| 278 | > | return 1; | 
| 279 |  | } | 
| 280 | < | print | 
| 281 | < | '               </ScatteringData> | 
| 282 | < | </WavelengthDataBlock> | 
| 283 | < | </WavelengthData> | 
| 284 | < | <WavelengthData> | 
| 285 | < | <LayerNumber>System</LayerNumber> | 
| 355 | < | <Wavelength unit="Integral">Visible</Wavelength> | 
| 356 | < | <SourceSpectrum>CIE Illuminant D65 1nm.ssp</SourceSpectrum> | 
| 357 | < | <DetectorSpectrum>ASTM E308 1931 Y.dsp</DetectorSpectrum> | 
| 358 | < | <WavelengthDataBlock> | 
| 359 | < | <WavelengthDataDirection>Reflection Back</WavelengthDataDirection> | 
| 360 | < | <ColumnAngleBasis>LBNL/Klems Full</ColumnAngleBasis> | 
| 361 | < | <RowAngleBasis>LBNL/Klems Full</RowAngleBasis> | 
| 362 | < | <ScatteringDataType>BRDF</ScatteringDataType> | 
| 363 | < | <ScatteringData> | 
| 364 | < | '; | 
| 365 | < | # Output back reflection (transposed order) | 
| 366 | < | for (my $od = 0; $od < $ndiv; $od++) { | 
| 367 | < | for (my $id = 0; $id < $ndiv; $id++) { | 
| 368 | < | print $rbarr[$ndiv*$id + $od]; | 
| 280 | > |  | 
| 281 | > | # Check if we are in active phase (not skipping parts) | 
| 282 | > | sub active_phase { | 
| 283 | > | if ( defined $recovery ) { | 
| 284 | > | if ( $recovery > $curphase ) { return 0; } | 
| 285 | > | if ( $recovery == $curphase ) { return -1; } | 
| 286 |  | } | 
| 287 | < | print "\n"; | 
| 287 | > | return 1; | 
| 288 |  | } | 
| 289 | < | print | 
| 290 | < | '               </ScatteringData> | 
| 291 | < | </WavelengthDataBlock> | 
| 292 | < | </WavelengthData> | 
| 293 | < | '; | 
| 289 | > |  | 
| 290 | > | # Function to run program and check output if in active phase | 
| 291 | > | sub run_check { | 
| 292 | > | if ( !active_phase() ) { return; } | 
| 293 | > | my $cmd = shift; | 
| 294 | > | # print STDERR "Running: $cmd\n"; | 
| 295 | > | system $cmd; | 
| 296 | > | die "Failure running: $cmd\n" if ( $? ); | 
| 297 |  | } | 
| 298 | < | # Output XML epilogue | 
| 299 | < | print '</Layer> | 
| 300 | < | </Optical> | 
| 301 | < | </WindowElement> | 
| 302 | < | '; | 
| 303 | < | # Clean up temporary files | 
| 304 | < | system "rm -rf $td"; | 
| 298 | > |  | 
| 299 | > | #++++++++++++++ Tensor tree BSDF generation ++++++++++++++# | 
| 300 | > | sub do_tree_bsdf { | 
| 301 | > |  | 
| 302 | > | # Run rfluxmtx processes to compute each side | 
| 303 | > | do_ttree_dir(0) if ( $doback ); | 
| 304 | > | do_ttree_dir(1) if ( $doforw ); | 
| 305 | > |  | 
| 306 | > | }       # end of sub do_tree_bsdf() | 
| 307 | > |  | 
| 308 | > | # Call rfluxmtx and process tensor tree BSDF for the given direction | 
| 309 | > | sub do_ttree_dir { | 
| 310 | > | my $forw = shift; | 
| 311 | > | my $dop = do_phase(); | 
| 312 | > | my $r = ($dop < 0) ? " -r" : ""; | 
| 313 | > | my $cmd; | 
| 314 | > | if ( $tensortree == 3 ) { | 
| 315 | > | # Isotropic BSDF | 
| 316 | > | my $ns2 = $ns / 2; | 
| 317 | > | if ($windoz) { | 
| 318 | > | $cmd = "cnt $ns2 $ny $nx " . | 
| 319 | > | qq{| rcalc -e "r1=rand(.8681*recno-.673892)" } . | 
| 320 | > | qq{-e "r2=rand(-5.37138*recno+67.1737811)" } . | 
| 321 | > | qq{-e "r3=rand(+3.17603772*recno+83.766771)" } . | 
| 322 | > | qq{-e "r4=rand(-1.5839226*recno-59.82712)" } . | 
| 323 | > | qq{-e "odds(n):if(.5*n-floor(.5*n)-.25,-1,1)"} . | 
| 324 | > | qq{-e "Dx=1-(\$1+r1)/$ns2" } . | 
| 325 | > | qq{-e "Dy=min(1/$ns,sqrt(1-Dx*Dx))*odds(\$1)*r2" } . | 
| 326 | > | qq{-e "Dz=sqrt(1-Dx*Dx-Dy*Dy)" } . | 
| 327 | > | qq{-e "xp=(\$3+r2)*(($dim[1]-$dim[0])/$nx)+$dim[0]" } . | 
| 328 | > | qq{-e "yp=(\$2+r3)*(($dim[3]-$dim[2])/$ny)+$dim[2]" } . | 
| 329 | > | qq{-e "zp=$dim[5-$forw]" -e "myDz=Dz*($forw*2-1)" } . | 
| 330 | > | qq{-e "\$1=xp-Dx;\$2=yp-Dy;\$3=zp-myDz" } . | 
| 331 | > | qq{-e "\$4=Dx;\$5=Dy;\$6=myDz" } . | 
| 332 | > | "| $rfluxmtx$r -fa -y $ns2 - $receivers -i $octree"; | 
| 333 | > | } else { | 
| 334 | > | $cmd = "cnt $ns2 $ny $nx " . | 
| 335 | > | qq{| rcalc -e 'r1=rand(.8681*recno-.673892)' } . | 
| 336 | > | qq{-e 'r2=rand(-5.37138*recno+67.1737811)' } . | 
| 337 | > | qq{-e 'r3=rand(+3.17603772*recno+83.766771)' } . | 
| 338 | > | qq{-e 'r4=rand(-1.5839226*recno-59.82712)' } . | 
| 339 | > | qq{-e 'odds(n):if(.5*n-floor(.5*n)-.25,-1,1)' } . | 
| 340 | > | qq{-e 'Dx=1-(\$1+r1)/$ns2' } . | 
| 341 | > | qq{-e 'Dy=min(1/$ns,sqrt(1-Dx*Dx))*odds(\$1)*r2' } . | 
| 342 | > | qq{-e 'Dz=sqrt(1-Dx*Dx-Dy*Dy)' } . | 
| 343 | > | qq{-e 'xp=(\$3+r3)*(($dim[1]-$dim[0])/$nx)+$dim[0]' } . | 
| 344 | > | qq{-e 'yp=(\$2+r4)*(($dim[3]-$dim[2])/$ny)+$dim[2]' } . | 
| 345 | > | qq{-e 'zp=$dim[5-$forw]' -e 'myDz=Dz*($forw*2-1)' } . | 
| 346 | > | qq{-e '\$1=xp-Dx;\$2=yp-Dy;\$3=zp-myDz' } . | 
| 347 | > | qq{-e '\$4=Dx;\$5=Dy;\$6=myDz' -of } . | 
| 348 | > | "| $rfluxmtx$r -ff -y $ns2 - $receivers -i $octree"; | 
| 349 | > | } | 
| 350 | > | } else { | 
| 351 | > | # Anisotropic BSDF | 
| 352 | > | my $sender = ($bsender,$fsender)[$forw]; | 
| 353 | > | if ($windoz) { | 
| 354 | > | $cmd = "$rfluxmtx$r -fa $sender $receivers -i $octree"; | 
| 355 | > | } else { | 
| 356 | > | $cmd = "$rfluxmtx$r -ff $sender $receivers -i $octree"; | 
| 357 | > | } | 
| 358 | > | } | 
| 359 | > | if ( $dop ) { | 
| 360 | > | # print STDERR "Running: $cmd\n"; | 
| 361 | > | system $cmd; | 
| 362 | > | die "Failure running rfluxmtx" if ( $? ); | 
| 363 | > | } | 
| 364 | > | ttree_out($forw); | 
| 365 | > | }       # end of do_ttree_dir() | 
| 366 | > |  | 
| 367 | > | # Simplify and store tensor tree results | 
| 368 | > | sub ttree_out { | 
| 369 | > | my $forw = shift; | 
| 370 | > | my ($refldat,$transdat); | 
| 371 | > | if ( $forw ) { | 
| 372 | > | $transdat = $facedat; | 
| 373 | > | $refldat = $behinddat; | 
| 374 | > | } else { | 
| 375 | > | $transdat = $behinddat; | 
| 376 | > | $refldat = $facedat; | 
| 377 | > | } | 
| 378 | > | # Only output one transmitted anisotropic distribution, preferring backwards | 
| 379 | > | if ( !$forw || !$doback || $tensortree==3 ) { | 
| 380 | > | my $ttyp = ("tb","tf")[$forw]; | 
| 381 | > | ttree_comp($ttyp, "Visible", $transdat, ($tb,$tf)[$forw]); | 
| 382 | > | if ( $docolor ) { | 
| 383 | > | ttree_comp($ttyp, "CIE-u", $transdat, ($tbx,$tfx)[$forw]); | 
| 384 | > | ttree_comp($ttyp, "CIE-v", $transdat, ($tbz,$tfz)[$forw]); | 
| 385 | > | } | 
| 386 | > | } | 
| 387 | > | # Output reflection | 
| 388 | > | my $rtyp = ("rb","rf")[$forw]; | 
| 389 | > | ttree_comp($rtyp, "Visible", $refldat, ($rb,$rf)[$forw]); | 
| 390 | > | if ( $docolor ) { | 
| 391 | > | ttree_comp($rtyp, "CIE-u", $refldat, ($rbx,$rfx)[$forw]); | 
| 392 | > | ttree_comp($rtyp, "CIE-v", $refldat, ($rbz,$rfz)[$forw]); | 
| 393 | > | } | 
| 394 | > | }       # end of ttree_out() | 
| 395 | > |  | 
| 396 | > | # Call rttree_reduce on the given component | 
| 397 | > | sub ttree_comp { | 
| 398 | > | my $typ = shift; | 
| 399 | > | my $spec = shift; | 
| 400 | > | my $src = shift; | 
| 401 | > | my $dest = shift; | 
| 402 | > | my $cmd; | 
| 403 | > | if ($windoz) { | 
| 404 | > | $cmd = "rcomb -fa -c xyz $src | rcollate -ho -oc 1" . | 
| 405 | > | q{ | rcalc -e "Xi=$1;Yi=$2;Zi=$3" }; | 
| 406 | > | if ("$spec" eq "Visible") { | 
| 407 | > | $cmd .= qq{-e "Omega:PI/($ns*$ns)" } . | 
| 408 | > | q{-e "$1=Yi/Omega"}; | 
| 409 | > | } elsif ("$spec" eq "CIE-u") { | 
| 410 | > | $cmd .= qq{-e "$CIEuv" } . | 
| 411 | > | q{-e "$1=uprime"}; | 
| 412 | > | } elsif ("$spec" eq "CIE-v") { | 
| 413 | > | $cmd .= qq{-e "$CIEuv" } . | 
| 414 | > | q{-e "$1=vprime"}; | 
| 415 | > | } | 
| 416 | > | } else { | 
| 417 | > | $cmd = "rcomb -ff -c xyz $src | getinfo -" . | 
| 418 | > | q{ | rcalc -if3 -of -e 'Xi=$1;Yi=$2;Zi=$3' }; | 
| 419 | > | if ("$spec" eq "Visible") { | 
| 420 | > | $cmd .= "-e 'Omega:PI/($ns*$ns)' " . | 
| 421 | > | q{-e '$1=Yi/Omega'}; | 
| 422 | > | } elsif ("$spec" eq "CIE-u") { | 
| 423 | > | $cmd .= "-e '$CIEuv' " . | 
| 424 | > | q{-e '$1=uprime'}; | 
| 425 | > | } elsif ("$spec" eq "CIE-v") { | 
| 426 | > | $cmd .= "-e '$CIEuv' " . | 
| 427 | > | q{-e '$1=vprime'}; | 
| 428 | > | } | 
| 429 | > | } | 
| 430 | > | if ($pctcull >= 0) { | 
| 431 | > | my $avg = ( $dorecip && ( $tensortree == 3 || "$typ" =~ /^r[fb]/ ) ) ? " -a" : ""; | 
| 432 | > | my $pcull = ("$spec" eq "Visible") ? $pctcull : | 
| 433 | > | (100 - (100-$pctcull)*.25) ; | 
| 434 | > | if ($windoz) { | 
| 435 | > | $cmd .= " | rttree_reduce$avg -h -fa -t $pcull -r $tensortree -g $ttlog2"; | 
| 436 | > | } else { | 
| 437 | > | $cmd .= " | rttree_reduce$avg -h -ff -t $pcull -r $tensortree -g $ttlog2"; | 
| 438 | > | } | 
| 439 | > | run_check "$cmd > $dest"; | 
| 440 | > | } else { | 
| 441 | > | if ( active_phase() ) { | 
| 442 | > | open(DATOUT, "> $dest"); | 
| 443 | > | print DATOUT "{\n"; | 
| 444 | > | close DATOUT; | 
| 445 | > | # print STDERR "Running: $cmd\n"; | 
| 446 | > | system "$cmd >> $dest"; | 
| 447 | > | die "Failure running rcalc" if ( $? ); | 
| 448 | > | open(DATOUT, ">> $dest"); | 
| 449 | > | for (my $i = ($tensortree==3)*$ns*$ns*$ns/2; $i-- > 0; ) { | 
| 450 | > | print DATOUT "0\n"; | 
| 451 | > | } | 
| 452 | > | print DATOUT "}\n"; | 
| 453 | > | close DATOUT; | 
| 454 | > | } | 
| 455 | > | } | 
| 456 | > | if ( "$spec" ne "$curspec" ) { | 
| 457 | > | $wrapper .= " -s $spec"; | 
| 458 | > | $curspec = $spec; | 
| 459 | > | } | 
| 460 | > | $wrapper .= " -$typ $dest"; | 
| 461 | > | }       # end of ttree_comp() | 
| 462 | > |  | 
| 463 | > | #------------- End of do_tree_bsdf() & subroutines -------------# | 
| 464 | > |  | 
| 465 | > | #+++++++++++++++ Klems matrix BSDF generation +++++++++++++++# | 
| 466 | > | sub do_matrix_bsdf { | 
| 467 | > |  | 
| 468 | > | # Run rfluxmtx processes to compute each side | 
| 469 | > | do_matrix_dir(0) if ( $doback ); | 
| 470 | > | do_matrix_dir(1) if ( $doforw ); | 
| 471 | > |  | 
| 472 | > | }       # end of sub do_matrix_bsdf() | 
| 473 | > |  | 
| 474 | > | # Call rfluxmtx and process tensor tree BSDF for the given direction | 
| 475 | > | sub do_matrix_dir { | 
| 476 | > | my $forw = shift; | 
| 477 | > | my $dop = do_phase(); | 
| 478 | > | my $r = ($dop < 0) ? " -r" : ""; | 
| 479 | > | my $sender = ($bsender,$fsender)[$forw]; | 
| 480 | > | my $cmd = "$rfluxmtx$r -ff $sender $receivers -i $octree"; | 
| 481 | > | if ( $dop ) { | 
| 482 | > | # print STDERR "Running: $cmd\n"; | 
| 483 | > | system $cmd; | 
| 484 | > | die "Failure running rfluxmtx" if ( $? ); | 
| 485 | > | } | 
| 486 | > | matrix_out($forw); | 
| 487 | > | }       # end of do_matrix_dir() | 
| 488 | > |  | 
| 489 | > | sub matrix_out { | 
| 490 | > | my $forw = shift; | 
| 491 | > | my ($refldat,$transdat); | 
| 492 | > | if ( $forw ) { | 
| 493 | > | $transdat = $facedat; | 
| 494 | > | $refldat = $behinddat; | 
| 495 | > | } else { | 
| 496 | > | $transdat = $behinddat; | 
| 497 | > | $refldat = $facedat; | 
| 498 | > | } | 
| 499 | > | # Output transmission | 
| 500 | > | my $ttyp = ("tb","tf")[$forw]; | 
| 501 | > | matrix_comp($ttyp, "Visible", $transdat, ($tb,$tf)[$forw]); | 
| 502 | > | if ( $docolor ) { | 
| 503 | > | matrix_comp($ttyp, "CIE-X", $transdat, ($tbx,$tfx)[$forw]); | 
| 504 | > | matrix_comp($ttyp, "CIE-Z", $transdat, ($tbz,$tfz)[$forw]); | 
| 505 | > | } | 
| 506 | > | # Output reflection | 
| 507 | > | my $rtyp = ("rb","rf")[$forw]; | 
| 508 | > | matrix_comp($rtyp, "Visible", $refldat, ($rb,$rf)[$forw]); | 
| 509 | > | if ( $docolor ) { | 
| 510 | > | matrix_comp($rtyp, "CIE-X", $refldat, ($rbx,$rfx)[$forw]); | 
| 511 | > | matrix_comp($rtyp, "CIE-Z", $refldat, ($rbz,$rfz)[$forw]); | 
| 512 | > | } | 
| 513 | > | }       # end of matrix_out() | 
| 514 | > |  | 
| 515 | > | # Transpose matrix component data and save to file | 
| 516 | > | sub matrix_comp { | 
| 517 | > | my $typ = shift; | 
| 518 | > | my $spec = shift; | 
| 519 | > | my $src = shift; | 
| 520 | > | my $dest = shift; | 
| 521 | > | my $cmd = "rmtxop -fa -t"; | 
| 522 | > | if ("$spec" eq "Visible") { | 
| 523 | > | $cmd .= " -c y"; | 
| 524 | > | } elsif ("$spec" eq "CIE-X") { | 
| 525 | > | $cmd .= " -c x"; | 
| 526 | > | } elsif ("$spec" eq "CIE-Z") { | 
| 527 | > | $cmd .= " -c z"; | 
| 528 | > | } | 
| 529 | > | $cmd .= " $src | getinfo -"; | 
| 530 | > | run_check "$cmd > $dest"; | 
| 531 | > | if ( "$spec" ne "$curspec" ) { | 
| 532 | > | $wrapper .= " -s $spec"; | 
| 533 | > | $curspec = $spec; | 
| 534 | > | } | 
| 535 | > | $wrapper .= " -$typ $dest"; | 
| 536 | > | }       # end of matrix_comp() | 
| 537 | > |  | 
| 538 | > | #------------- End of do_matrix_bsdf() & subroutines --------------# |