| 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][-dim xmin xmax ymin ymax zmin zmax][{+|-}mgf][{+|-}geom] [input ..]\n"; | 
| 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"; | 
| 13 |  | exit 1; | 
| 14 |  | } | 
| 15 | < | my $td = `mktemp -d /tmp/genBSDF.XXXXXX`; | 
| 16 | < | chomp $td; | 
| 17 | < | my $nsamp = 1000; | 
| 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) { | 
| 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 | > | $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 | > | chomp $td; | 
| 42 | > | $rmtmp = "rmdir /S /Q $td"; | 
| 43 | > | } else { | 
| 44 | > | $td = mkdtemp("/tmp/genBSDF.XXXXXX"); | 
| 45 | > | chomp $td; | 
| 46 | > | $radscn = "$td/device.rad"; | 
| 47 | > | $mgfscn = "$td/device.mgf"; | 
| 48 | > | $octree = "$td/device.oct"; | 
| 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 | > | $rmtmp = "rm -rf $td"; | 
| 67 | > | } | 
| 68 | > | my @savedARGV = @ARGV; | 
| 69 | > | my $rfluxmtx = "rfluxmtx -v -ab 5 -ad 700 -lw 3e-6"; | 
| 70 | > | my $wrapper = "wrapBSDF"; | 
| 71 | > | my $tensortree = 0; | 
| 72 | > | my $ttlog2 = 4; | 
| 73 | > | my $nsamp = 2000; | 
| 74 |  | my $mgfin = 0; | 
| 75 |  | my $geout = 1; | 
| 76 |  | my $nproc = 1; | 
| 77 | + | my $docolor = 0; | 
| 78 | + | my $doforw = 0; | 
| 79 | + | my $doback = 1; | 
| 80 | + | my $pctcull = 90; | 
| 81 | + | my $gunit = "meter"; | 
| 82 | + | my $curspec = "Visible"; | 
| 83 |  | my @dim; | 
| 84 |  | # Get options | 
| 85 |  | while ($#ARGV >= 0) { | 
| 86 |  | if ("$ARGV[0]" =~ /^[-+]m/) { | 
| 87 |  | $mgfin = ("$ARGV[0]" =~ /^\+/); | 
| 88 | + | } elsif ("$ARGV[0]" eq "-r") { | 
| 89 | + | $rfluxmtx .= " $ARGV[1]"; | 
| 90 | + | shift @ARGV; | 
| 91 |  | } elsif ("$ARGV[0]" =~ /^[-+]g/) { | 
| 92 |  | $geout = ("$ARGV[0]" =~ /^\+/); | 
| 93 | + | $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 | + | } elsif ("$ARGV[0]" =~ /^[-+]C/) { | 
| 99 | + | $docolor = ("$ARGV[0]" =~ /^\+/); | 
| 100 | + | } elsif ("$ARGV[0]" =~ /^[-+]f/) { | 
| 101 | + | $doforw = ("$ARGV[0]" =~ /^\+/); | 
| 102 | + | } elsif ("$ARGV[0]" =~ /^[-+]b/) { | 
| 103 | + | $doback = ("$ARGV[0]" =~ /^\+/); | 
| 104 | + | } elsif ("$ARGV[0]" eq "-t") { | 
| 105 | + | # Use value < 0 for rttree_reduce bypass | 
| 106 | + | $pctcull = $ARGV[1]; | 
| 107 | + | shift @ARGV; | 
| 108 | + | } elsif ("$ARGV[0]" =~ /^-t[34]$/) { | 
| 109 | + | $tensortree = substr($ARGV[0], 2, 1); | 
| 110 | + | $ttlog2 = $ARGV[1]; | 
| 111 | + | shift @ARGV; | 
| 112 | + | } elsif ("$ARGV[0]" eq "-f") { | 
| 113 | + | $wrapper .= " -f \"$ARGV[1]\""; | 
| 114 | + | shift @ARGV; | 
| 115 | + | } elsif ("$ARGV[0]" eq "-W") { | 
| 116 | + | $wrapper .= " -W"; | 
| 117 |  | } elsif ("$ARGV[0]" eq "-c") { | 
| 118 |  | $nsamp = $ARGV[1]; | 
| 119 |  | shift @ARGV; | 
| 122 |  | shift @ARGV; | 
| 123 |  | } elsif ("$ARGV[0]" =~ /^-d/) { | 
| 124 |  | userror() if ($#ARGV < 6); | 
| 125 | < | @dim = "@ARGV[1..6]"; | 
| 125 | > | @dim = @ARGV[1..6]; | 
| 126 |  | shift @ARGV for (1..6); | 
| 127 |  | } elsif ("$ARGV[0]" =~ /^[-+]./) { | 
| 128 |  | userror(); | 
| 131 |  | } | 
| 132 |  | shift @ARGV; | 
| 133 |  | } | 
| 134 | + | # Check that we're actually being asked to do something | 
| 135 | + | 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)); | 
| 139 | + | $wrapper .= $tensortree ? " -a t$tensortree" : " -a kf -c"; | 
| 140 | + | $wrapper .= " -u $gunit"; | 
| 141 |  | # Get scene description and dimensions | 
| 44 | – | my $radscn = "$td/device.rad"; | 
| 45 | – | my $mgfscn = "$td/device.mgf"; | 
| 46 | – | my $octree = "$td/device.oct"; | 
| 142 |  | if ( $mgfin ) { | 
| 143 | < | 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"; | 
| 143 | > | system "mgf2rad @ARGV > $radscn"; | 
| 144 |  | die "Could not load MGF input\n" if ( $? ); | 
| 50 | – | system "mgf2rad $mgfscn > $radscn"; | 
| 145 |  | } else { | 
| 146 | < | system "cat @ARGV | xform -e > $radscn"; | 
| 146 | > | system "xform -e @ARGV > $radscn"; | 
| 147 |  | die "Could not load Radiance input\n" if ( $? ); | 
| 54 | – | system "rad2mgf $radscn > $mgfscn" if ( $geout ); | 
| 148 |  | } | 
| 149 |  | if ($#dim != 5) { | 
| 150 | < | @dim = split /\s+/, `getbbox -h $radscn`; | 
| 58 | < | shift @dim; | 
| 150 | > | @dim = split ' ', `getbbox -h $radscn`; | 
| 151 |  | } | 
| 152 |  | print STDERR "Warning: Device extends into room\n" if ($dim[5] > 1e-5); | 
| 153 | < | # Add receiver surface (rectangle) | 
| 154 | < | my $modnm="_receiver_black_"; | 
| 63 | < | open(RADSCN, ">> $radscn"); | 
| 64 | < | print RADSCN "void glow $modnm\n0\n0\n4 0 0 0 0\n\n"; | 
| 65 | < | print RADSCN "$modnm polygon _receiver_\n0\n0\n12\n"; | 
| 66 | < | print RADSCN "\t",$dim[0],"\t",$dim[2],"\t",$dim[5]+1e-5,"\n"; | 
| 67 | < | print RADSCN "\t",$dim[0],"\t",$dim[3],"\t",$dim[5]+1e-5,"\n"; | 
| 68 | < | print RADSCN "\t",$dim[1],"\t",$dim[3],"\t",$dim[5]+1e-5,"\n"; | 
| 69 | < | print RADSCN "\t",$dim[1],"\t",$dim[2],"\t",$dim[5]+1e-5,"\n"; | 
| 70 | < | close RADSCN; | 
| 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 | < | # Set up sampling | 
| 75 | < | # Kbin to produce incident direction in full Klems basis with (x1,x2) randoms | 
| 76 | < | my $tcal = ' | 
| 77 | < | DEGREE : PI/180; | 
| 78 | < | sq(x) : x*x; | 
| 79 | < | Kpola(r) : select(r+1, -5, 5, 15, 25, 35, 45, 55, 65, 75, 90); | 
| 80 | < | Knaz(r) : select(r, 1, 8, 16, 20, 24, 24, 24, 16, 12); | 
| 81 | < | Kaccum(r) : if(r-.5, Knaz(r) + Kaccum(r-1), 0); | 
| 82 | < | Kmax : Kaccum(Knaz(0)); | 
| 83 | < | Kfindrow(r, rem) : if(rem-Knaz(r)+.5, Kfindrow(r+1, rem-Knaz(r)), r); | 
| 84 | < | Krow = if(Kbin-(Kmax-.5), 0, Kfindrow(1, Kbin)); | 
| 85 | < | Kcol = Kbin - Kaccum(Krow-1); | 
| 86 | < | Kazi = 360*DEGREE * (Kcol + (.5 - x2)) / Knaz(Krow); | 
| 87 | < | Kpol = DEGREE * (x1*Kpola(Krow) + (1-x1)*Kpola(Krow-1)); | 
| 88 | < | sin_kpol = sin(Kpol); | 
| 89 | < | Dx = -cos(Kazi)*sin_kpol; | 
| 90 | < | Dy = sin(Kazi)*sin_kpol; | 
| 91 | < | Dz = sqrt(1 - sin_kpol*sin_kpol); | 
| 92 | < | KprojOmega = PI * if(Kbin-.5, | 
| 93 | < | (sq(cos(Kpola(Krow-1)*DEGREE)) - sq(cos(Kpola(Krow)*DEGREE)))/Knaz(Krow), | 
| 94 | < | 1 - sq(cos(Kpola(1)*DEGREE))); | 
| 95 | < | '; | 
| 96 | < | # Compute Klems bin from exiting ray direction | 
| 97 | < | my $kcal = ' | 
| 98 | < | DEGREE : PI/180; | 
| 99 | < | Acos(x) : 1/DEGREE * if(x-1, 0, if(-1-x, 0, acos(x))); | 
| 100 | < | posangle(a) : if(-a, a + 2*PI, a); | 
| 101 | < | Atan2(y,x) : 1/DEGREE * posangle(atan2(y,x)); | 
| 102 | < | kpola(r) : select(r, 5, 15, 25, 35, 45, 55, 65, 75, 90); | 
| 103 | < | knaz(r) : select(r, 1, 8, 16, 20, 24, 24, 24, 16, 12); | 
| 104 | < | kaccum(r) : if(r-.5, knaz(r) + kaccum(r-1), 0); | 
| 105 | < | kfindrow(r, pol) : if(r-kpola(0)+.5, r, | 
| 106 | < | if(pol-kpola(r), kfindrow(r+1, pol), r) ); | 
| 107 | < | kazn(azi,inc) : if((360-.5*inc)-azi, floor((azi+.5*inc)/inc), 0); | 
| 108 | < | kbin2(pol,azi) = select(kfindrow(1, pol), | 
| 109 | < | kazn(azi,360/knaz(1)), | 
| 110 | < | kaccum(1) + kazn(azi,360/knaz(2)), | 
| 111 | < | kaccum(2) + kazn(azi,360/knaz(3)), | 
| 112 | < | kaccum(3) + kazn(azi,360/knaz(4)), | 
| 113 | < | kaccum(4) + kazn(azi,360/knaz(5)), | 
| 114 | < | kaccum(5) + kazn(azi,360/knaz(6)), | 
| 115 | < | kaccum(6) + kazn(azi,360/knaz(7)), | 
| 116 | < | kaccum(7) + kazn(azi,360/knaz(8)), | 
| 117 | < | kaccum(8) + kazn(azi,360/knaz(9)) | 
| 118 | < | ); | 
| 119 | < | kbin = kbin2(Acos(Dz), Atan2(Dy, -Dx)); | 
| 120 | < | '; | 
| 121 | < | my $ndiv = 145; | 
| 122 | < | my $nx = int(sqrt($nsamp*($dim[1]-$dim[0])/($dim[3]-$dim[2])) + .5); | 
| 123 | < | my $ny = int($nsamp/$nx + .5); | 
| 124 | < | $nsamp = $nx * $ny; | 
| 125 | < | # Compute scattering data using rtcontrib | 
| 126 | < | my $cmd = "cnt $ndiv $ny $nx | rcalc -of -e '$tcal' " . | 
| 127 | < | "-e 'xp=(\$3+rand(.35*recno-15))*(($dim[1]-$dim[0])/$nx)+$dim[0]' " . | 
| 128 | < | "-e 'yp=(\$2+rand(.86*recno+11))*(($dim[3]-$dim[2])/$ny)+$dim[2]' " . | 
| 129 | < | "-e 'zp:$dim[4]-1e-5' " . | 
| 130 | < | q{-e 'Kbin=$1;x1=rand(1.21*recno+2.75);x2=rand(-3.55*recno-7.57)' } . | 
| 131 | < | q{-e '$1=xp;$2=yp;$3=zp;$4=Dx;$5=Dy;$6=Dz' } . | 
| 132 | < | "| rtcontrib -h -ff -n $nproc -c $nsamp -e '$kcal' -b kbin -bn $ndiv " . | 
| 133 | < | "-m $modnm -w -ab 5 -ad 700 -lw 3e-6 $octree " . | 
| 134 | < | "| rcalc -e '$tcal' " . | 
| 135 | < | "-e 'mod(n,d):n-floor(n/d)*d' -e 'Kbin=mod(recno-.999,$ndiv)' " . | 
| 136 | < | q{-if3 -e '$1=(0.265*$1+0.670*$2+0.065*$3)/KprojOmega'}; | 
| 137 | < | my @darr = `$cmd`; | 
| 138 | < | die "Failure running: $cmd\n" if ( $? ); | 
| 139 | < | # Output XML prologue | 
| 140 | < | print | 
| 141 | < | '<?xml version="1.0" encoding="UTF-8"?> | 
| 142 | < | <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"> | 
| 143 | < | <WindowElementType>System</WindowElementType> | 
| 144 | < | <Optical> | 
| 145 | < | <Layer> | 
| 146 | < | <Material> | 
| 147 | < | <Name>Name</Name> | 
| 148 | < | <Manufacturer>Manufacturer</Manufacturer> | 
| 149 | < | '; | 
| 150 | < | printf "\t\t\t<Thickness unit=\"Meter\">%.3f</Thickness>\n", $dim[5] - $dim[4]; | 
| 151 | < | printf "\t\t\t<Width unit=\"Meter\">%.3f</Width>\n", $dim[1] - $dim[0]; | 
| 152 | < | printf "\t\t\t<Height unit=\"Meter\">%.3f</Height>\n", $dim[3] - $dim[2]; | 
| 153 | < | print "\t\t\t<DeviceType>Integral</DeviceType>\n"; | 
| 154 | < | # Output MGF description if requested | 
| 158 | > | # Add MGF description if requested | 
| 159 |  | if ( $geout ) { | 
| 160 | < | print "\t\t\t<Geometry format=\"MGF\" unit=\"Meter\">\n"; | 
| 161 | < | printf "xf -t %.6f %.6f 0\n", -($dim[0]+$dim[1])/2, -($dim[2]+$dim[3])/2; | 
| 162 | < | system "cat $mgfscn"; | 
| 163 | < | print "xf\n"; | 
| 164 | < | print "\t\t\t</Geometry>\n"; | 
| 165 | < | } | 
| 166 | < | print '                 </Material> | 
| 163 | < | <DataDefinition> | 
| 164 | < | <IncidentDataStructure>Columns</IncidentDataStructure> | 
| 165 | < | <AngleBasis> | 
| 166 | < | <AngleBasisName>LBNL/Klems Full</AngleBasisName> | 
| 167 | < | <AngleBasisBlock> | 
| 168 | < | <Theta>0</Theta> | 
| 169 | < | <nPhis>1</nPhis> | 
| 170 | < | <ThetaBounds> | 
| 171 | < | <LowerTheta>0</LowerTheta> | 
| 172 | < | <UpperTheta>5</UpperTheta> | 
| 173 | < | </ThetaBounds> | 
| 174 | < | </AngleBasisBlock> | 
| 175 | < | <AngleBasisBlock> | 
| 176 | < | <Theta>10</Theta> | 
| 177 | < | <nPhis>8</nPhis> | 
| 178 | < | <ThetaBounds> | 
| 179 | < | <LowerTheta>5</LowerTheta> | 
| 180 | < | <UpperTheta>15</UpperTheta> | 
| 181 | < | </ThetaBounds> | 
| 182 | < | </AngleBasisBlock> | 
| 183 | < | <AngleBasisBlock> | 
| 184 | < | <Theta>20</Theta> | 
| 185 | < | <nPhis>16</nPhis> | 
| 186 | < | <ThetaBounds> | 
| 187 | < | <LowerTheta>15</LowerTheta> | 
| 188 | < | <UpperTheta>25</UpperTheta> | 
| 189 | < | </ThetaBounds> | 
| 190 | < | </AngleBasisBlock> | 
| 191 | < | <AngleBasisBlock> | 
| 192 | < | <Theta>30</Theta> | 
| 193 | < | <nPhis>20</nPhis> | 
| 194 | < | <ThetaBounds> | 
| 195 | < | <LowerTheta>25</LowerTheta> | 
| 196 | < | <UpperTheta>35</UpperTheta> | 
| 197 | < | </ThetaBounds> | 
| 198 | < | </AngleBasisBlock> | 
| 199 | < | <AngleBasisBlock> | 
| 200 | < | <Theta>40</Theta> | 
| 201 | < | <nPhis>24</nPhis> | 
| 202 | < | <ThetaBounds> | 
| 203 | < | <LowerTheta>35</LowerTheta> | 
| 204 | < | <UpperTheta>45</UpperTheta> | 
| 205 | < | </ThetaBounds> | 
| 206 | < | </AngleBasisBlock> | 
| 207 | < | <AngleBasisBlock> | 
| 208 | < | <Theta>50</Theta> | 
| 209 | < | <nPhis>24</nPhis> | 
| 210 | < | <ThetaBounds> | 
| 211 | < | <LowerTheta>45</LowerTheta> | 
| 212 | < | <UpperTheta>55</UpperTheta> | 
| 213 | < | </ThetaBounds> | 
| 214 | < | </AngleBasisBlock> | 
| 215 | < | <AngleBasisBlock> | 
| 216 | < | <Theta>60</Theta> | 
| 217 | < | <nPhis>24</nPhis> | 
| 218 | < | <ThetaBounds> | 
| 219 | < | <LowerTheta>55</LowerTheta> | 
| 220 | < | <UpperTheta>65</UpperTheta> | 
| 221 | < | </ThetaBounds> | 
| 222 | < | </AngleBasisBlock> | 
| 223 | < | <AngleBasisBlock> | 
| 224 | < | <Theta>70</Theta> | 
| 225 | < | <nPhis>16</nPhis> | 
| 226 | < | <ThetaBounds> | 
| 227 | < | <LowerTheta>65</LowerTheta> | 
| 228 | < | <UpperTheta>75</UpperTheta> | 
| 229 | < | </ThetaBounds> | 
| 230 | < | </AngleBasisBlock> | 
| 231 | < | <AngleBasisBlock> | 
| 232 | < | <Theta>82.5</Theta> | 
| 233 | < | <nPhis>12</nPhis> | 
| 234 | < | <ThetaBounds> | 
| 235 | < | <LowerTheta>75</LowerTheta> | 
| 236 | < | <UpperTheta>90</UpperTheta> | 
| 237 | < | </ThetaBounds> | 
| 238 | < | </AngleBasisBlock> | 
| 239 | < | </AngleBasis> | 
| 240 | < | </DataDefinition> | 
| 241 | < | <WavelengthData> | 
| 242 | < | <LayerNumber>System</LayerNumber> | 
| 243 | < | <Wavelength unit="Integral">Visible</Wavelength> | 
| 244 | < | <SourceSpectrum>CIE Illuminant D65 1nm.ssp</SourceSpectrum> | 
| 245 | < | <DetectorSpectrum>ASTM E308 1931 Y.dsp</DetectorSpectrum> | 
| 246 | < | <WavelengthDataBlock> | 
| 247 | < | <WavelengthDataDirection>Transmission Front</WavelengthDataDirection> | 
| 248 | < | <ColumnAngleBasis>LBNL/Klems Full</ColumnAngleBasis> | 
| 249 | < | <RowAngleBasis>LBNL/Klems Full</RowAngleBasis> | 
| 250 | < | <ScatteringDataType>BTDF</ScatteringDataType> | 
| 251 | < | <ScatteringData> | 
| 252 | < | '; | 
| 253 | < | # Output computed data (transposed order) | 
| 254 | < | for (my $od = 0; $od < $ndiv; $od++) { | 
| 255 | < | for (my $id = 0; $id < $ndiv; $id++) { | 
| 256 | < | print $darr[$ndiv*$id + $od]; | 
| 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; | 
| 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 | < | print "\n"; | 
| 168 | > | open(MGFSCN, ">> $mgfscn"); | 
| 169 | > | print MGFSCN "xf\n"; | 
| 170 | > | close MGFSCN; | 
| 171 | > | $wrapper .= " -g $mgfscn"; | 
| 172 |  | } | 
| 173 | < | # Output XML epilogue | 
| 174 | < | print | 
| 175 | < | '               </ScatteringData> | 
| 176 | < | </WavelengthDataBlock> | 
| 177 | < | </WavelengthData> | 
| 178 | < | </Layer> | 
| 179 | < | </Optical> | 
| 180 | < | </WindowElement> | 
| 181 | < | '; | 
| 182 | < | # Clean up temporary files | 
| 183 | < | system "rm -rf $td"; | 
| 173 | > | # Create receiver & sender surfaces (rectangular) | 
| 174 | > | my $nx = int(sqrt($nsamp*($dim[1]-$dim[0])/($dim[3]-$dim[2])) + 1); | 
| 175 | > | my $ny = int($nsamp/$nx + 1); | 
| 176 | > | $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 | 
| 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 | > | # Create data segments (all the work happens here) | 
| 208 | > | if ( $tensortree ) { | 
| 209 | > | do_tree_bsdf(); | 
| 210 | > | } else { | 
| 211 | > | do_matrix_bsdf(); | 
| 212 | > | } | 
| 213 | > | # 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 | > | # Clean up temporary files and exit | 
| 222 | > | system $rmtmp; | 
| 223 | > |  | 
| 224 | > | #-------------- End of main program segment --------------# | 
| 225 | > |  | 
| 226 | > | #++++++++++++++ Tensor tree BSDF generation ++++++++++++++# | 
| 227 | > | sub do_tree_bsdf { | 
| 228 | > |  | 
| 229 | > | # Run rfluxmtx processes to compute each side | 
| 230 | > | do_ttree_dir(0) if ( $doback ); | 
| 231 | > | do_ttree_dir(1) if ( $doforw ); | 
| 232 | > |  | 
| 233 | > | }       # end of sub do_tree_bsdf() | 
| 234 | > |  | 
| 235 | > | # Call rfluxmtx and process tensor tree BSDF for the given direction | 
| 236 | > | sub do_ttree_dir { | 
| 237 | > | my $forw = shift; | 
| 238 | > | my $cmd; | 
| 239 | > | if ( $tensortree == 3 ) { | 
| 240 | > | # Isotropic BSDF | 
| 241 | > | my $ns2 = $ns / 2; | 
| 242 | > | 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 | > | "| $rfluxmtx -fa -y $ns2 - $receivers -i $octree"; | 
| 254 | > | } 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 | > | "| $rfluxmtx -h -ff -y $ns2 - $receivers -i $octree"; | 
| 266 | > | } | 
| 267 | > | } else { | 
| 268 | > | # Anisotropic BSDF | 
| 269 | > | my $sender = ($bsender,$fsender)[$forw]; | 
| 270 | > | if ($windoz) { | 
| 271 | > | $cmd = "$rfluxmtx -fa $sender $receivers -i $octree"; | 
| 272 | > | } else { | 
| 273 | > | $cmd = "$rfluxmtx -h -ff $sender $receivers -i $octree"; | 
| 274 | > | } | 
| 275 | > | } | 
| 276 | > | # print STDERR "Starting: $cmd\n"; | 
| 277 | > | system $cmd; | 
| 278 | > | die "Failure running rfluxmtx" if ( $? ); | 
| 279 | > | ttree_out($forw); | 
| 280 | > | }       # end of do_ttree_dir() | 
| 281 | > |  | 
| 282 | > | # Simplify and store tensor tree results | 
| 283 | > | sub ttree_out { | 
| 284 | > | my $forw = shift; | 
| 285 | > | my ($refldat,$transdat); | 
| 286 | > | if ( $forw ) { | 
| 287 | > | $transdat = $facedat; | 
| 288 | > | $refldat = $behinddat; | 
| 289 | > | } else { | 
| 290 | > | $transdat = $behinddat; | 
| 291 | > | $refldat = $facedat; | 
| 292 | > | } | 
| 293 | > | # 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 | > | } | 
| 302 | > | # 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 | > | } | 
| 309 | > | }       # 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 | > | if ($windoz) { | 
| 319 | > | 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 | > | } else { | 
| 330 | > | 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 | > | } | 
| 341 | > | 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 | > | } else { | 
| 355 | > | 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 | > | } | 
| 373 | > | if ( "$spec" ne "$curspec" ) { | 
| 374 | > | $wrapper .= " -s $spec"; | 
| 375 | > | $curspec = $spec; | 
| 376 | > | } | 
| 377 | > | $wrapper .= " -$typ $dest"; | 
| 378 | > | }       # end of ttree_comp() | 
| 379 | > |  | 
| 380 | > | #------------- End of do_tree_bsdf() & subroutines -------------# | 
| 381 | > |  | 
| 382 | > | #+++++++++++++++ Klems matrix BSDF generation +++++++++++++++# | 
| 383 | > | sub do_matrix_bsdf { | 
| 384 | > |  | 
| 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 | > | } else { | 
| 410 | > | $transdat = $behinddat; | 
| 411 | > | $refldat = $facedat; | 
| 412 | > | } | 
| 413 | > | # 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 | > | $cmd .= " $src | rcollate -ho -oc 145"; | 
| 444 | > | # print STDERR "Running: $cmd\n"; | 
| 445 | > | system "$cmd > $dest"; | 
| 446 | > | die "Failure running rttree_reduce" if ( $? ); | 
| 447 | > | if ( "$spec" ne "$curspec" ) { | 
| 448 | > | $wrapper .= " -s $spec"; | 
| 449 | > | $curspec = $spec; | 
| 450 | > | } | 
| 451 | > | $wrapper .= " -$typ $dest"; | 
| 452 | > | }       # end of matrix_comp() | 
| 453 | > |  | 
| 454 | > | #------------- End of do_matrix_bsdf() & subroutines --------------# |