ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/px/falsecolor.pl
Revision: 2.10
Committed: Tue Apr 15 21:34:31 2014 UTC (10 years ago) by greg
Content type: text/plain
Branch: MAIN
CVS Tags: rad4R2P2, rad5R0, rad5R1, rad4R2, rad4R2P1
Changes since 2.9: +3 -2 lines
Log Message:
Added handling of file names with spaces

File Contents

# User Rev Content
1 greg 2.1 #!/usr/bin/perl -w
2 greg 2.10 # RCSid $Id: falsecolor.pl,v 2.9 2013/04/04 02:59:20 greg Exp $
3 greg 2.1
4 greg 2.5 use warnings;
5 greg 2.1 use strict;
6     use File::Temp qw/ tempdir /;
7     use POSIX qw/ floor /;
8    
9 greg 2.9 my @palettes = ('def', 'spec', 'pm3d', 'hot', 'eco');
10 greg 2.5
11     my $mult = 179.0; # Multiplier. Default W/sr/m2 -> cd/m2
12     my $label = 'cd/m2'; # Units shown in legend
13     my $scale = 1000; # Top of the scale
14     my $decades = 0; # Default is linear mapping
15     my $pal = 'def'; # Palette
16     my $redv = "${pal}_red(v)"; # Mapping functions for R,G,B
17     my $grnv = "${pal}_grn(v)";
18     my $bluv = "${pal}_blu(v)";
19     my $ndivs = 8; # Number of lines in legend
20 greg 2.1 my $picture = '-';
21     my $cpict = '';
22 greg 2.5 my $legwidth = 100; # Legend width and height
23 greg 2.1 my $legheight = 200;
24 greg 2.6 my $docont = ''; # Contours: -cl and -cb
25     my $doposter = 0; # Posterization: -cp
26 greg 2.5 my $loff = 0; # Offset to align with values
27     my $doextrem = 0; # Don't mark extrema
28 greg 2.1 my $needfile = 0;
29 greg 2.6 my $showpal = 0; # Show availabel colour palettes
30 greg 2.1
31     while ($#ARGV >= 0) {
32 greg 2.5 $_ = shift;
33     # Options with qualifiers
34     if (m/-lw/) { # Legend width
35     $legwidth = shift;
36     } elsif (m/-lh/) { # Legend height
37     $legheight = shift;
38     } elsif (m/-m/) { # Multiplier
39     $mult = shift;
40 greg 2.9 } elsif (m/-spec/) {
41     die("depricated option '-spec'. Please use '-pal spec' instead.");
42 greg 2.5 } elsif (m/-s/) { # Scale
43     $scale = shift;
44 greg 2.1 if ($scale =~ m/[aA].*/) {
45     $needfile = 1;
46     }
47 greg 2.5 } elsif (m/-l$/) { # Label
48     $label = shift;
49     } elsif (m/-log/) { # Logarithmic mapping
50     $decades = shift;
51     } elsif (m/-r/) { # Custom palette functions for R,G,B
52     $redv = shift;
53     } elsif (m/-g/) {
54     $grnv = shift;
55     } elsif (m/-b/) {
56     $bluv = shift;
57     } elsif (m/-pal$/) { # Color palette
58     $pal = shift;
59     if (! grep $_ eq $pal, @palettes) {
60     die("invalid palette '$pal'.\n");
61     }
62     $redv = "${pal}_red(v)";
63     $grnv = "${pal}_grn(v)";
64     $bluv = "${pal}_blu(v)";
65     } elsif (m/-i$/) { # Image for intensity mapping
66     $picture = shift;
67     } elsif (m/-p$/) { # Image for background
68     $cpict = shift;
69     } elsif (m/-ip/ || m/-pi/) {
70     $picture = shift;
71     $cpict = $picture;
72     } elsif (m/-n/) { # Number of contour lines
73     $ndivs = shift;
74 greg 2.1
75 greg 2.5 # Switches
76     } elsif (m/-cl/) { # Contour lines
77 greg 2.1 $docont = 'a';
78 greg 2.4 $loff = 0.48;
79 greg 2.5 } elsif (m/-cb/) { # Contour bands
80 greg 2.1 $docont = 'b';
81 greg 2.4 $loff = 0.52;
82 greg 2.6 } elsif (m/-cp/) { # Posterize
83     $doposter = 1;
84     } elsif (m/-palettes/) { # Show all available palettes
85     $scale = 45824; # 256 * 179
86     $showpal = 1;
87 greg 2.5 } elsif (m/-e/) {
88 greg 2.1 $doextrem = 1;
89     $needfile = 1;
90    
91 greg 2.5 # Oops! Illegal option
92 greg 2.1 } else {
93 greg 2.5 die("bad option \"$_\"\n");
94 greg 2.1 }
95     }
96    
97     # Temporary directory. Will be removed upon successful program exit.
98     my $td = tempdir( CLEANUP => 1 );
99    
100     if ($needfile == 1 && $picture eq '-') {
101 greg 2.5 # Pretend that $td/stdin.rad is the actual filename.
102 greg 2.3 $picture = "$td/stdin.hdr";
103 greg 2.1 open(FHpic, ">$picture") or
104     die("Unable to write to file $picture\n");
105 greg 2.5 # Input is from STDIN: Capture to file.
106     while (<>) {
107     print FHpic;
108     }
109 greg 2.1 close(FHpic);
110 greg 2.3
111 greg 2.5 if ($cpict eq '-') {
112 greg 2.6 $cpict = "$td/stdin.hdr";
113 greg 2.5 }
114 greg 2.1 }
115    
116     # Find a good scale for auto mode.
117     if ($scale =~ m/[aA].*/) {
118 greg 2.5 my @histo = split(/\s/, `phisto $picture| tail -2`);
119     # e.g. $ phisto tests/richmond.hdr| tail -2
120     # 3.91267 14
121     # 3.94282 6
122     my $LogLmax = $histo[0];
123 greg 2.1 $scale = $mult / 179 * 10**$LogLmax;
124     }
125    
126 greg 2.3 my $pc0 = "$td/pc0.cal";
127 greg 2.1 open(FHpc0, ">$pc0");
128     print FHpc0 <<EndOfPC0;
129     PI : 3.14159265358979323846 ;
130     scale : $scale ;
131     mult : $mult ;
132     ndivs : $ndivs ;
133     gamma : 2.2;
134    
135     or(a,b) : if(a,a,b);
136     EPS : 1e-7;
137     neq(a,b) : if(a-b-EPS,1,b-a-EPS);
138     btwn(a,x,b) : if(a-x,-1,b-x);
139     clip(x) : if(x-1,1,if(x,x,0));
140     frac(x) : x - floor(x);
141     boundary(a,b) : neq(floor(ndivs*a+.5),floor(ndivs*b+.5));
142    
143     spec_red(x) = 1.6*x - .6;
144     spec_grn(x) = if(x-.375, 1.6-1.6*x, 8/3*x);
145     spec_blu(x) = 1 - 8/3*x;
146    
147     pm3d_red(x) = sqrt(x) ^ gamma;
148 greg 2.5 pm3d_grn(x) = (x*x*x) ^ gamma;
149 greg 2.6 pm3d_blu(x) = clip(sin(2*PI*clip(x))) ^ gamma;
150 greg 2.1
151     hot_red(x) = clip(3*x) ^ gamma;
152     hot_grn(x) = clip(3*x - 1) ^ gamma;
153     hot_blu(x) = clip(3*x - 2) ^ gamma;
154    
155 greg 2.9 eco_red(x) = clip(2*x) ^ gamma;
156     eco_grn(x) = clip(2*(x-0.5)) ^ gamma;
157     eco_blu(x) = clip(2*(0.5-x)) ^ gamma;
158    
159 greg 2.1 interp_arr2(i,x,f):(i+1-x)*f(i)+(x-i)*f(i+1);
160     interp_arr(x,f):if(x-1,if(f(0)-x,interp_arr2(floor(x),x,f),f(f(0))),f(1));
161    
162     def_redp(i):select(i,0.18848,0.05468174,
163     0.00103547,8.311144e-08,7.449763e-06,0.0004390987,0.001367254,
164     0.003076,0.01376382,0.06170773,0.1739422,0.2881156,0.3299725,
165     0.3552663,0.372552,0.3921184,0.4363976,0.6102754,0.7757267,
166     0.9087369,1,1,0.9863);
167     def_red(x):interp_arr(x/0.0454545+1,def_redp);
168    
169     def_grnp(i):select(i,0.0009766,2.35501e-05,
170     0.0008966244,0.0264977,0.1256843,0.2865799,0.4247083,0.4739468,
171     0.4402732,0.3671876,0.2629843,0.1725325,0.1206819,0.07316644,
172     0.03761026,0.01612362,0.004773749,6.830967e-06,0.00803605,
173     0.1008085,0.3106831,0.6447838,0.9707);
174     def_grn(x):interp_arr(x/0.0454545+1,def_grnp);
175    
176     def_blup(i):select(i,0.2666,0.3638662,0.4770437,
177     0.5131397,0.5363797,0.5193677,0.4085123,0.1702815,0.05314236,
178     0.05194055,0.08564082,0.09881395,0.08324373,0.06072902,
179     0.0391076,0.02315354,0.01284458,0.005184709,0.001691774,
180     2.432735e-05,1.212949e-05,0.006659406,0.02539);
181     def_blu(x):interp_arr(x/0.0454545+1,def_blup);
182    
183     isconta = if(btwn(0,v,1),or(boundary(vleft,vright),boundary(vabove,vbelow)),-1);
184     iscontb = if(btwn(0,v,1),btwn(.4,frac(ndivs*v),.6),-1);
185    
186     ra = 0;
187     ga = 0;
188     ba = 0;
189    
190     in = 1;
191    
192     ro = if(in,clip($redv),ra);
193     go = if(in,clip($grnv),ga);
194     bo = if(in,clip($bluv),ba);
195     EndOfPC0
196 greg 2.6 close FHpc0;
197 greg 2.1
198 greg 2.3 my $pc1 = "$td/pc1.cal";
199 greg 2.1 open(FHpc1, ">$pc1");
200     print FHpc1 <<EndOfPC1;
201     norm : mult/scale/le(1);
202    
203     v = map(li(1)*norm);
204    
205     vleft = map(li(1,-1,0)*norm);
206     vright = map(li(1,1,0)*norm);
207     vabove = map(li(1,0,1)*norm);
208     vbelow = map(li(1,0,-1)*norm);
209    
210     map(x) = x;
211    
212     ra = ri(nfiles);
213     ga = gi(nfiles);
214     ba = bi(nfiles);
215     EndOfPC1
216 greg 2.6 close FHpc1;
217 greg 2.1
218     my $pc0args = "-f $pc0";
219     my $pc1args = "-f $pc1";
220    
221 greg 2.6 if ($showpal == 1) {
222     my $pc = "pcompos -a 1";
223     foreach my $pal (@palettes) {
224     my $fcimg = "$td/$pal.hdr";
225     my $lbimg = "$td/${pal}_label.hdr";
226     system "psign -cb 0 0 0 -cf 1 1 1 -h 20 $pal > $lbimg";
227    
228     my $cmd = qq[pcomb $pc0args -e "v=x/256"];
229     $cmd .= qq[ -e "ro=clip(${pal}_red(v));go=clip(${pal}_grn(v));bo=clip(${pal}_blu(v))"];
230     $cmd .= qq[ -x 256 -y 30 > $fcimg];
231     system "$cmd";
232     $pc .= " $fcimg $lbimg";
233     }
234     system "$pc";
235     exit 0;
236     }
237    
238     # Contours
239 greg 2.1 if ($docont ne '') {
240 greg 2.6 # -cl -> $docont = a
241     # -cb -> $docont = b
242     $pc0args .= qq[ -e "in=iscont$docont"];
243     } elsif ($doposter == 1) {
244     # -cp -> $doposter = 1
245     $pc0args .= qq[ -e "ro=${pal}_red(seg(v));go=${pal}_grn(seg(v));bo=${pal}_blu(seg(v))"];
246     $pc0args .= q[ -e "seg(x)=(floor(v*ndivs)+.5)/ndivs"];
247 greg 2.1 }
248    
249     if ($cpict eq '') {
250 greg 2.6 $pc1args .= qq[ -e "ra=0;ga=0;ba=0"];
251 greg 2.1 } elsif ($cpict eq $picture) {
252     $cpict = '';
253     }
254    
255     # Logarithmic mapping
256     if ($decades > 0) {
257 greg 2.6 $pc1args .= qq[ -e "map(x)=if(x-10^-$decades,log10(x)/$decades+1,0)"];
258 greg 2.1 }
259    
260     # Colours in the legend
261 greg 2.3 my $scolpic = "$td/scol.hdr";
262 greg 2.6
263 greg 2.1 # Labels in the legend
264 greg 2.3 my $slabpic = "$td/slab.hdr";
265 greg 2.1 my $cmd;
266    
267 greg 2.3 if (($legwidth > 20) && ($legheight > 40)) {
268 greg 2.5 # Legend: Create the text labels
269 greg 2.1 my $sheight = floor($legheight / $ndivs + 0.5);
270 greg 2.4 $legheight = $sheight * $ndivs;
271     $loff = floor($loff * $sheight + 0.5);
272 greg 2.1 my $text = "$label";
273 greg 2.3 for (my $i=0; $i<$ndivs; $i++) {
274 greg 2.1 my $imap = ($ndivs - 0.5 - $i) / $ndivs;
275 greg 2.5 my $value = $scale;
276 greg 2.1 if ($decades > 0) {
277 greg 2.3 $value *= 10**(($imap - 1) * $decades);
278 greg 2.1 } else {
279 greg 2.3 $value *= $imap;
280 greg 2.1 }
281 greg 2.6
282 greg 2.1 # Have no more than 3 decimal places
283     $value =~ s/(\.[0-9]{3})[0-9]*/$1/;
284     $text .= "\n$value";
285     }
286 greg 2.8 open PSIGN, "| psign -s -.15 -cf 1 1 1 -cb 0 0 0 -h $sheight > $slabpic";
287     print PSIGN "$text\n";
288     close PSIGN;
289 greg 2.4
290 greg 2.5 # Legend: Create the background colours
291 greg 2.6 $cmd = qq[pcomb $pc0args];
292     $cmd .= q[ -e "v=(y+.5)/yres;vleft=v;vright=v"];
293     $cmd .= q[ -e "vbelow=(y-.5)/yres;vabove=(y+1.5)/yres"];
294     $cmd .= qq[ -x $legwidth -y $legheight > $scolpic];
295 greg 2.4 system $cmd;
296 greg 2.1 } else {
297 greg 2.5 # Legend is too small to be legible. Don't bother doing one.
298 greg 2.1 $legwidth = 0;
299     $legheight = 0;
300 greg 2.4 $loff = 0;
301 greg 2.6
302 greg 2.5 # Create dummy colour scale and legend labels so we don't
303     # need to change the final command line.
304 greg 2.1 open(FHscolpic, ">$scolpic");
305 greg 2.2 print FHscolpic "\n-Y 1 +X 1\naaa\n";
306 greg 2.1 close(FHscolpic);
307     open(FHslabpic, ">$slabpic");
308 greg 2.2 print FHslabpic "\n-Y 1 +X 1\naaa\n";
309 greg 2.1 close(FHslabpic);
310     }
311    
312 greg 2.3 # Legend: Invert the text labels (for dropshadow)
313     my $slabinvpic = "$td/slabinv.hdr";
314 greg 2.6 $cmd = qq[pcomb -e "lo=1-gi(1)" $slabpic > $slabinvpic];
315 greg 2.3 system $cmd;
316    
317 greg 2.1 my $loff1 = $loff - 1;
318 greg 2.6
319 greg 2.1 # Command line without extrema
320 greg 2.10 $cmd = qq[pcomb $pc0args $pc1args "$picture"];
321     $cmd .= qq[ "$cpict"] if ($cpict);
322 greg 2.6 $cmd .= qq[ | pcompos $scolpic 0 0 +t .1 $slabinvpic 2 $loff1];
323     $cmd .= qq[ -t .5 $slabpic 0 $loff - $legwidth 0];
324 greg 2.1
325     if ($doextrem == 1) {
326 greg 2.5 # Get min/max image luminance
327 greg 2.1 my $cmd1 = 'pextrem -o ' . $picture;
328     my $retval = `$cmd1`;
329     # e.g.
330     # x y r g b
331     # 193 207 3.070068e-02 3.118896e-02 1.995850e-02
332     # 211 202 1.292969e+00 1.308594e+00 1.300781e+00
333    
334     my @extrema = split(/\s/, $retval);
335 greg 2.3 my ($lxmin, $ymin, $rmin, $gmin, $bmin, $lxmax, $ymax, $rmax, $gmax, $bmax) = @extrema;
336 greg 2.5 $lxmin += $legwidth;
337     $lxmax += $legwidth;
338 greg 2.1
339 greg 2.5 # Weighted average of R,G,B
340 greg 2.1 my $minpos = "$lxmin $ymin";
341     my $minval = ($rmin * .27 + $gmin * .67 + $bmin * .06) * $mult;
342     $minval =~ s/(\.[0-9]{3})[0-9]*/$1/;
343     my $maxval = ($rmax * .27 + $gmax * .67 + $bmax * .06) * $mult;
344     $maxval =~ s/(\.[0-9]{3})[0-9]*/$1/;
345    
346 greg 2.5 # Create the labels for min/max intensity
347 greg 2.3 my $minvpic = "$td/minv.hdr";
348 greg 2.6 system "psign -s -.15 -a 2 -h 16 $minval > $minvpic";
349 greg 2.3 my $maxvpic = "$td/maxv.hdr";
350 greg 2.6 system "psign -s -.15 -a 2 -h 16 $maxval > $maxvpic";
351 greg 2.1
352 greg 2.5 # Add extrema labels to command line
353 greg 2.6 $cmd .= qq[ $minvpic $minpos $maxvpic $lxmax $ymax];
354 greg 2.1 }
355    
356     # Process image and combine with legend
357     system "$cmd";
358    
359     #EOF