#!/usr/bin/perl -w # RCSid $Id: iso2klems.pl,v 2.6 2022/10/06 14:22:44 greg Exp $ # # Convert tabulated isotropic direct-hemispherical and direct-direct to Klems XML # # G. Ward # use strict; my $windoz = ($^O eq "MSWin32" or $^O eq "MSWin64"); use File::Temp qw/ :mktemp /; sub userror { print STDERR "Usage: iso2klems [-t][-f \"x=string;y=string\"][-u unit] [input.dat]\n"; exit 1; } my ($td,$rmtmp,$cmd); if ($windoz) { my $tmploc = `echo \%TMP\%`; chomp $tmploc; $td = mkdtemp("$tmploc\\iso2klems.XXXXXX"); $rmtmp = "rd /S /Q $td"; } else { $td = mkdtemp("/tmp/iso2klems.XXXXXX"); chomp $td; $rmtmp = "rm -rf $td"; } my $wrapper = 'wrapBSDF -W -a kf -C "Generated by iso2klems"'; my $reverse = 0; # Get options while ($#ARGV >= 0) { if ("$ARGV[0]" eq "-t") { $reverse = ! $reverse; } elsif ("$ARGV[0]" =~ /^-[fs]$/) { $wrapper .= " -f \"$ARGV[1]\""; shift @ARGV; } elsif ("$ARGV[0]" eq "-u") { $wrapper .= " -u $ARGV[1]"; shift @ARGV; } elsif ("$ARGV[0]" =~ /^-./) { userror(); } else { last; } shift @ARGV; } userror() if ($#ARGV > 0); my $funcfile = "$td/isofuncs.cal"; my @vnm = ("Tspec","Tdiff","Rspec","Rdiff"); if ($#ARGV == 0) { system "tabfunc -i @vnm < \"$ARGV[0]\" > $funcfile"; } else { system "tabfunc -i @vnm > $funcfile"; } die "Invalid input data, requires 5 columns\n" if ( $? ); open (MYFH, ">> $funcfile"); print MYFH "DEG : PI/180;\n"; print MYFH "sq(x) : x*x;\n"; print MYFH "eq(a,b) : min(a-b+1e-5,b-a+1e-5);\n"; print MYFH "rtheta(i) : select(i,5,15,25,35,45,55,65,75,90);\n"; print MYFH "nphis(i) : select(i,1,8,16,20,24,24,24,16,12);\n"; print MYFH "tdeg1(tb) : if(tb-1.5, (rtheta(tb)+rtheta(tb-1))/2, 0);\n"; print MYFH "omega1(tb) : PI*if(tb-1.5, (sq(cos(rtheta(tb-1)*DEG))-sq(cos(rtheta(tb)*DEG)))/nphis(tb),"; print MYFH "\t(1 - sq(cos(rtheta(1)*DEG))));\n"; print MYFH "tbin(b,cnt) : if(nphis(b)-cnt-.5, b, tbin(b+1,cnt-nphis(b)));\n"; print MYFH "tdeg(b) : tdeg1(tbin(1,b-1));\n"; print MYFH "omega(b) : omega1(tbin(1,b-1));\n"; close MYFH; # Compute front and back diffuse hemispherical integrals my $hsamps = 26; my $nsamps = $hsamps * 2; if ($windoz) { $cmd = qq{cnt $nsamps } . qq{| rcalc -f $funcfile -w -e "tdeg=180/$nsamps*(\$1+.5);abs(x):if(x,x,-x)" } . qq{-e "theta=tdeg*DEG;ifact=PI*PI*abs(cos(theta))*sin(theta)" } . q{-e "$1=ifact*Tdiff(tdeg);$2=ifact*Rdiff(tdeg)" } . qq{| total -$hsamps -m}; } else { $cmd = qq{cnt $nsamps } . qq{| rcalc -f $funcfile -w -e 'tdeg=180/$nsamps*(\$1+.5);abs(x):if(x,x,-x)' } . qq{-e 'theta=tdeg*DEG;ifact=PI*PI*abs(cos(theta))*sin(theta)' } . q{-e '$1=ifact*Tdiff(tdeg);$2=ifact*Rdiff(tdeg)' -od } . qq{| total -id2 -$hsamps -m}; } # Returns side 1 Th-h, side 1 Rh-h, side 2 Th-h, side 2 Rh-h my @h2h = split /\s+/, `$cmd`; die "Error running rcalc" if ( $? || $#h2h != 3 ); # Compute Klems matrices my $TK1dataf = "$td/trans1m.txt"; my $RK1dataf = "$td/refl1m.txt"; my $TK2dataf = "$td/trans2m.txt"; my $RK2dataf = "$td/refl2m.txt"; if ($windoz) { $cmd = qq{cnt 145 145 } . qq{| rcalc -f $funcfile } . q{-e "diag=eq($1,$2);tideg=tdeg($1+1);tsdeg=tdeg($2+1);om=omega($1+1);corr=PI/(PI-om)" } . qq{-e "Td1=if($h2h[0]-.001,Tdiff(tideg)*Tdiff(tsdeg)/$h2h[0],0)" } . qq{-e "Rd1=if($h2h[1]-.001,Rdiff(tideg)*Rdiff(tsdeg)/$h2h[1],0)" } . qq{-e "Td2=if($h2h[2]-.001,Tdiff(180-tideg)*Tdiff(180-tsdeg)/$h2h[2],0)" } . qq{-e "Rd2=if($h2h[3]-.001,Rdiff(180-tideg)*Rdiff(180-tsdeg)/$h2h[3],0)" } . q{-e "$1=if(Tspec(0),if(diag,Tspec(tideg)/om,Td1*corr),Td1)" } . q{-e "$2=if(Rspec(0),if(diag,Rspec(tideg)/om,Rd1*corr),Rd1)" } . q{-e "$3=if(Tspec(180),if(diag,Tspec(180-tideg)/om,Td2*corr),Td2)" } . q{-e "$4=if(Rspec(180),if(diag,Rspec(180-tideg)/om,Rd2*corr),Rd2)" }; } else { $cmd = qq{cnt 145 145 } . qq{| rcalc -f $funcfile } . q{-e 'diag=eq($1,$2);tideg=tdeg($1+1);tsdeg=tdeg($2+1);om=omega($1+1);corr=PI/(PI-om)' } . qq{-e 'Td1=if($h2h[0]-.001,Tdiff(tideg)*Tdiff(tsdeg)/$h2h[0],0)' } . qq{-e 'Rd1=if($h2h[1]-.001,Rdiff(tideg)*Rdiff(tsdeg)/$h2h[1],0)' } . qq{-e 'Td2=if($h2h[2]-.001,Tdiff(180-tideg)*Tdiff(180-tsdeg)/$h2h[2],0)' } . qq{-e 'Rd2=if($h2h[3]-.001,Rdiff(180-tideg)*Rdiff(180-tsdeg)/$h2h[3],0)' } . q{-e '$1=if(Tspec(0),if(diag,Tspec(tideg)/om,Td1*corr),Td1)' } . q{-e '$2=if(Rspec(0),if(diag,Rspec(tideg)/om,Rd1*corr),Rd1)' } . q{-e '$3=if(Tspec(180),if(diag,Tspec(180-tideg)/om,Td2*corr),Td2)' } . q{-e '$4=if(Rspec(180),if(diag,Rspec(180-tideg)/om,Rd2*corr),Rd2)' }; } system qq{$cmd | rsplit "-t " $TK1dataf $RK1dataf $TK2dataf $RK2dataf}; die "Error running rcalc or rsplit" if ( $? ); if ($reverse) { $wrapper .= " -tf $TK2dataf -rf $RK2dataf -tb $TK1dataf -rb $RK1dataf"; } else { $wrapper .= " -tf $TK1dataf -rf $RK1dataf -tb $TK2dataf -rb $RK2dataf"; } system $wrapper; die "Error running: $wrapper\n" if ( $? ); exec $rmtmp;