ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/px/falsecolor.pl
(Generate patch)

Comparing ray/src/px/falsecolor.pl (file contents):
Revision 2.1 by greg, Tue Oct 5 00:59:39 2010 UTC vs.
Revision 2.11 by greg, Tue Sep 5 22:42:52 2017 UTC

# Line 1 | Line 1
1   #!/usr/bin/perl -w
2   # RCSid $Id$
3  
4 + use warnings;
5   use strict;
6   use File::Temp qw/ tempdir /;
7   use POSIX qw/ floor /;
8  
9 < my $mult = 179.0;    # Multiplier. Default W/sr/m2 -> cd/m2
10 < my $label = 'cd/m2';    # Units shown in legend
11 < my $scale = 1000;    # Top of the scale
12 < my $decades = 0;    # Default is linear mapping
13 < my $redv = 'def_red(v)';    # Mapping function for R,G,B
14 < my $grnv = 'def_grn(v)';
15 < my $bluv = 'def_blu(v)';
16 < my $ndivs = 8;    # Number of lines in legend
9 > my @palettes = ('def', 'spec', 'pm3d', 'hot', 'eco');
10 >
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 $matchscale = 1;            # Adjust top of scale to match given label
15 > my $decades = 0;               # Default is linear mapping
16 > my $pal = 'def';               # Palette
17 > my $redv = "${pal}_red(v)";    # Mapping functions for R,G,B
18 > my $grnv = "${pal}_grn(v)";
19 > my $bluv = "${pal}_blu(v)";
20 > my $ndivs = 8;                 # Number of lines in legend
21   my $picture = '-';
22   my $cpict = '';
23 < my $legwidth = 100;   # Legend width and height
23 > my $legwidth = 100;            # Legend width and height
24   my $legheight = 200;
25 < my $docont = '';    # Contours
26 < my $loff = 0;    # Offset for drop-shadow
27 < my $doextrem = 0;    # Don't mark extrema
25 > my $docont = '';               # Contours: -cl and -cb
26 > my $doposter = 0;              # Posterization: -cp
27 > my $loff = 0;                  # Offset to align with values
28 > my $doextrem = 0;              # Don't mark extrema
29   my $needfile = 0;
30 + my $showpal = 0;               # Show availabel colour palettes
31  
32   while ($#ARGV >= 0) {
33 <        # Options with qualifiers
34 <    if ("$ARGV[0]" eq '-lw') {    # Legend width
35 <        $legwidth = $ARGV[1];
36 <        shift @ARGV;
37 <    } elsif ("$ARGV[0]" eq '-lh') {    # Legend height
38 <        $legheight = $ARGV[1];
39 <        shift @ARGV;
40 <    } elsif ("$ARGV[0]" eq '-m') {    # Multiplier
41 <        $mult = $ARGV[1];
42 <        shift @ARGV;
43 <    } elsif ("$ARGV[0]" eq '-s') {    # Scale
44 <        $scale = $ARGV[1];
38 <        shift @ARGV;
33 >    $_ = shift;
34 >    # Options with qualifiers
35 >    if (m/-lw/) {              # Legend width
36 >        $legwidth = shift;
37 >    } elsif (m/-lh/) {         # Legend height
38 >        $legheight = shift;
39 >    } elsif (m/-m/) {          # Multiplier
40 >        $mult = shift;
41 >    } elsif (m/-spec/) {
42 >        die("depricated option '-spec'. Please use '-pal spec' instead.");
43 >    } elsif (m/-s/) {          # Scale
44 >        $scale = shift;
45          if ($scale =~ m/[aA].*/) {
46 +            $matchscale = 0;
47              $needfile = 1;
48 +       } else {
49 +            $matchscale = 1;
50 +        }
51 +    } elsif (m/-l$/) {         # Label
52 +        $label = shift;
53 +    } elsif (m/-log/) {        # Logarithmic mapping
54 +        $decades = shift;
55 +    } elsif (m/-r/) {          # Custom palette functions for R,G,B
56 +        $redv = shift;
57 +    } elsif (m/-g/) {
58 +        $grnv = shift;
59 +    } elsif (m/-b/) {
60 +        $bluv = shift;
61 +    } elsif (m/-pal$/) {        # Color palette
62 +        $pal = shift;
63 +        if (! grep $_ eq $pal, @palettes) {
64 +            die("invalid palette '$pal'.\n");
65          }
66 <    } elsif ("$ARGV[0]" eq '-l') {    # Label
67 <        $label = $ARGV[1];
68 <        shift @ARGV;
69 <    } elsif ("$ARGV[0]" eq '-log') {    # Logarithmic mapping
70 <        $decades = $ARGV[1];
71 <        shift @ARGV;
72 <    } elsif ("$ARGV[0]" eq '-r') {
73 <        $redv = $ARGV[1];
74 <        shift @ARGV;
75 <    } elsif ("$ARGV[0]" eq '-g') {
76 <        $grnv = $ARGV[1];
77 <        shift @ARGV;
54 <    } elsif ("$ARGV[0]" eq '-b') {
55 <        $bluv = $ARGV[1];
56 <        shift @ARGV;
57 <    } elsif ("$ARGV[0]" eq '-pal') {
58 <        $redv = "$ARGV[1]_red(v)";
59 <        $grnv = "$ARGV[1]_grn(v)";
60 <        $bluv = "$ARGV[1]_blu(v)";
61 <        shift @ARGV;
62 <    } elsif ("$ARGV[0]" eq '-i') {    # Image for intensity mapping
63 <        $picture = $ARGV[1];
64 <        shift @ARGV;
65 <    } elsif ("$ARGV[0]" eq '-p') {    # Image for background
66 <        $cpict = $ARGV[1];
67 <        shift @ARGV;
68 <    } elsif ("$ARGV[0]" eq '-ip' || "$ARGV[0]" eq '-pi') {
69 <        $picture = $ARGV[1];
70 <        $cpict = $ARGV[1];
71 <        shift @ARGV;
72 <    } elsif ("$ARGV[0]" eq '-n') {    # Number of contour lines
73 <        $ndivs = $ARGV[1];
74 <        shift @ARGV;
66 >        $redv = "${pal}_red(v)";
67 >        $grnv = "${pal}_grn(v)";
68 >        $bluv = "${pal}_blu(v)";
69 >    } elsif (m/-i$/) {          # Image for intensity mapping
70 >        $picture = shift;
71 >    } elsif (m/-p$/) {         # Image for background
72 >        $cpict = shift;
73 >    } elsif (m/-ip/ || m/-pi/) {
74 >        $picture = shift;
75 >        $cpict = $picture;
76 >    } elsif (m/-n/) {          # Number of contour lines
77 >        $ndivs = shift;
78  
79 <        # Switches
80 <    } elsif ("$ARGV[0]" eq '-cl') {    # Contour lines
79 >    # Switches
80 >    } elsif (m/-cl/) {         # Contour lines
81          $docont = 'a';
82 <        $loff = 12;
83 <    } elsif ("$ARGV[0]" eq '-cb') {    # Contour bands
82 >        $loff = 0.48;
83 >    } elsif (m/-cb/) {         # Contour bands
84          $docont = 'b';
85 <        $loff = 13;
86 <    } elsif ("$ARGV[0]" eq '-e') {
85 >        $loff = 0.52;
86 >    } elsif (m/-cp/) {              # Posterize
87 >        $doposter = 1;
88 >    } elsif (m/-palettes/) {        # Show all available palettes
89 >        $scale   = 45824;           # 256 * 179
90 >        $showpal = 1;
91 >    } elsif (m/-e/) {
92          $doextrem = 1;
93          $needfile = 1;
94  
95 <        # Oops! Illegal option
95 >    # Oops! Illegal option
96      } else {
97 <        die("bad option \"$ARGV[0]\"\n");
97 >        die("bad option \"$_\"\n");
98      }
91    shift @ARGV;
99   }
100  
101 + if (($legwidth <= 20) || ($legheight <= 40)) {
102 +    # Legend is too small to be legible. Don't bother doing one.
103 +    $legwidth = 0;
104 +    $legheight = 0;
105 +    $loff = 0;
106 +    $matchscale = 0;
107 + }
108 +
109   # Temporary directory. Will be removed upon successful program exit.
110   my $td = tempdir( CLEANUP => 1 );
111  
112   if ($needfile == 1 && $picture eq '-') {
113 <    $picture = $td . '/' . $picture;
113 >    # Pretend that $td/stdin.rad is the actual filename.
114 >    $picture = "$td/stdin.hdr";
115      open(FHpic, ">$picture") or
116              die("Unable to write to file $picture\n");
117 +    # Input is from STDIN: Capture to file.
118 +    while (<>) {
119 +        print FHpic;
120 +    }
121      close(FHpic);
122 +
123 +    if ($cpict eq '-') {
124 +        $cpict = "$td/stdin.hdr";
125 +    }
126   }
127  
128   # Find a good scale for auto mode.
129   if ($scale =~ m/[aA].*/) {
130 <    my $LogLmax = `phisto $picture| tail -2| sed -n '1s/[0-9]*\$//p'`;
130 >    my @histo = split(/\s/, `phisto $picture| tail -2`);
131 >    # e.g. $ phisto tests/richmond.hdr| tail -2
132 >    # 3.91267   14
133 >    # 3.94282   6
134 >    my $LogLmax = $histo[0];
135      $scale = $mult / 179 * 10**$LogLmax;
136 + } elsif ($matchscale) {
137 +    # Adjust scale so legend reflects -s setting
138 +    if ($decades > 0) {
139 +        $scale *= 10**($decades/(2.*$ndivs));
140 +    } else {
141 +        $scale *= $ndivs/($ndivs - .5);
142 +    }
143   }
144  
145 < my $pc0 = $td . '/pc0.cal';
145 > my $pc0 = "$td/pc0.cal";
146   open(FHpc0, ">$pc0");
147   print FHpc0 <<EndOfPC0;
148   PI : 3.14159265358979323846 ;
# Line 129 | Line 164 | spec_grn(x) = if(x-.375, 1.6-1.6*x, 8/3*x);
164   spec_blu(x) = 1 - 8/3*x;
165  
166   pm3d_red(x) = sqrt(x) ^ gamma;
167 < pm3d_grn(x) = x*x*x ^ gamma;
168 < pm3d_blu(x) = clip(sin(2*PI*x)) ^ gamma;
167 > pm3d_grn(x) = (x*x*x) ^ gamma;
168 > pm3d_blu(x) = clip(sin(2*PI*clip(x))) ^ gamma;
169  
170   hot_red(x) = clip(3*x) ^ gamma;
171   hot_grn(x) = clip(3*x - 1) ^ gamma;
172   hot_blu(x) = clip(3*x - 2) ^ gamma;
173  
174 + eco_red(x) = clip(2*x) ^ gamma;
175 + eco_grn(x) = clip(2*(x-0.5)) ^ gamma;
176 + eco_blu(x) = clip(2*(0.5-x)) ^ gamma;
177 +
178   interp_arr2(i,x,f):(i+1-x)*f(i)+(x-i)*f(i+1);
179   interp_arr(x,f):if(x-1,if(f(0)-x,interp_arr2(floor(x),x,f),f(f(0))),f(1));
180  
# Line 173 | Line 212 | ro = if(in,clip($redv),ra);
212   go = if(in,clip($grnv),ga);
213   bo = if(in,clip($bluv),ba);
214   EndOfPC0
215 + close FHpc0;
216  
217 < my $pc1 = $td . '/pc1.cal';
217 > my $pc1 = "$td/pc1.cal";
218   open(FHpc1, ">$pc1");
219   print FHpc1 <<EndOfPC1;
220   norm : mult/scale/le(1);
# Line 192 | Line 232 | ra = ri(nfiles);
232   ga = gi(nfiles);
233   ba = bi(nfiles);
234   EndOfPC1
235 + close FHpc1;
236  
237   my $pc0args = "-f $pc0";
238   my $pc1args = "-f $pc1";
239  
240 < # Contour lines or bands
240 > if ($showpal == 1) {
241 >    my $pc = "pcompos -a 1";
242 >    foreach my $pal (@palettes) {
243 >        my $fcimg = "$td/$pal.hdr";
244 >        my $lbimg = "$td/${pal}_label.hdr";
245 >        system "psign -cb 0 0 0 -cf 1 1 1 -h 20 $pal > $lbimg";
246 >
247 >        my $cmd = qq[pcomb $pc0args -e "v=x/256"];
248 >        $cmd .= qq[ -e "ro=clip(${pal}_red(v));go=clip(${pal}_grn(v));bo=clip(${pal}_blu(v))"];
249 >        $cmd .= qq[ -x 256 -y 30 > $fcimg];
250 >        system "$cmd";
251 >        $pc .= " $fcimg $lbimg";
252 >    }
253 >    system "$pc";
254 >    exit 0;
255 > }
256 >
257 > # Contours
258   if ($docont ne '') {
259 <    $pc0args .= " -e 'in=iscont$docont'";
259 >    # -cl -> $docont = a
260 >    # -cb -> $docont = b
261 >    $pc0args .= qq[ -e "in=iscont$docont"];
262 > } elsif ($doposter == 1) {
263 >    # -cp -> $doposter = 1
264 >    $pc0args .= qq[ -e "ro=${pal}_red(seg(v));go=${pal}_grn(seg(v));bo=${pal}_blu(seg(v))"];
265 >    $pc0args .= q[ -e "seg(x)=(floor(v*ndivs)+.5)/ndivs"];
266   }
267  
268   if ($cpict eq '') {
269 <    $pc1args .= " -e 'ra=0;ga=0;ba=0'";
269 >    $pc1args .= qq[ -e "ra=0;ga=0;ba=0"];
270   } elsif ($cpict eq $picture) {
271      $cpict = '';
272   }
273  
274   # Logarithmic mapping
275   if ($decades > 0) {
276 <    $pc1args .= " -e 'map(x)=if(x-10^-$decades,log10(x)/$decades+1,0)'";
276 >    $pc1args .= qq[ -e "map(x)=if(x-10^-$decades,log10(x)/$decades+1,0)"];
277   }
278  
279   # Colours in the legend
280 < my $scolpic = $td . '/scol.hdr';
280 > my $scolpic = "$td/scol.hdr";
281 >
282   # Labels in the legend
283 < my $slabpic = $td . '/slab.hdr';
283 > my $slabpic = "$td/slab.hdr";
284   my $cmd;
285  
286 < if ($legwidth > 20 && $legheight > 40) {
287 <        # Legend: Create the background colours
223 <    $cmd = "pcomb $pc0args -e 'v=(y+.5)/yres;vleft=v;vright=v'";
224 <    $cmd .= " -e 'vbelow=(y-.5)/yres;vabove=(y+1.5)/yres'";
225 <    $cmd .= " -x $legwidth -y $legheight > $scolpic";
226 <    system $cmd;
227 <
228 <        # Legend: Create the text labels
286 > if ($legwidth > 0) {
287 >    # Legend: Create the text labels
288      my $sheight = floor($legheight / $ndivs + 0.5);
289 +    $legheight = $sheight * $ndivs;
290 +    $loff = floor($loff * $sheight + 0.5);
291      my $text = "$label";
292 <    my $value;
232 <    my $i;
233 <    for ($i=0; $i<$ndivs; $i++) {
292 >    for (my $i=0; $i<$ndivs; $i++) {
293          my $imap = ($ndivs - 0.5 - $i) / $ndivs;
294 +        my $value = $scale;
295          if ($decades > 0) {
296 <            $value = $scale * 10**(($imap - 1) * $decades);
296 >            $value *= 10**(($imap - 1) * $decades);
297          } else {
298 <            $value = $scale * $imap;
298 >            $value *= $imap;
299          }
300 +
301          # Have no more than 3 decimal places
302          $value =~ s/(\.[0-9]{3})[0-9]*/$1/;
303          $text .= "\n$value";
304      }
305 <    $cmd = "echo '$text' | psign -s -.15 -cf 1 1 1 -cb 0 0 0";
306 <    $cmd .= " -h $sheight > $slabpic";
305 >    open PSIGN, "| psign -s -.15 -cf 1 1 1 -cb 0 0 0 -h $sheight > $slabpic";
306 >    print PSIGN "$text\n";
307 >    close PSIGN;
308 >
309 >    # Legend: Create the background colours
310 >    $cmd = qq[pcomb $pc0args];
311 >    $cmd .= q[ -e "v=(y+.5)/yres;vleft=v;vright=v"];
312 >    $cmd .= q[ -e "vbelow=(y-.5)/yres;vabove=(y+1.5)/yres"];
313 >    $cmd .= qq[ -x $legwidth -y $legheight > $scolpic];
314      system $cmd;
315   } else {
316 <        # Legend is too small to be legible. Don't bother doing one.
317 <    $legwidth = 0;
250 <    $legheight = 0;
316 >    # Create dummy colour scale and legend labels so we don't
317 >    # need to change the final command line.
318      open(FHscolpic, ">$scolpic");
319 <    print FHscolpic '\n-Y 1 +X 1\naaa\n';
319 >    print FHscolpic "\n-Y 1 +X 1\naaa\n";
320      close(FHscolpic);
321      open(FHslabpic, ">$slabpic");
322 <    print FHslabpic '\n-Y 1 +X 1\naaa\n';
322 >    print FHslabpic "\n-Y 1 +X 1\naaa\n";
323      close(FHslabpic);
324   }
325  
326 + # Legend: Invert the text labels (for dropshadow)
327 + my $slabinvpic = "$td/slabinv.hdr";
328 + $cmd = qq[pcomb -e "lo=1-gi(1)" $slabpic > $slabinvpic];
329 + system $cmd;
330 +
331   my $loff1 = $loff - 1;
332 +
333   # Command line without extrema
334 < $cmd = "pcomb $pc0args $pc1args $picture $cpict";
335 < $cmd .= "| pcompos $scolpic 0 0 +t .1";
336 < $cmd .= " \"\!pcomb -e 'lo=1-gi(1)' $slabpic\" 2 $loff1";
337 < $cmd .= " -t .5 $slabpic 0 $loff - $legwidth 0";
334 > $cmd = qq[pcomb $pc0args $pc1args "$picture"];
335 > $cmd .= qq[ "$cpict"] if ($cpict);
336 > $cmd .= qq[ | pcompos $scolpic 0 0 +t .1 $slabinvpic 2 $loff1];
337 > $cmd .= qq[ -t .5 $slabpic 0 $loff - $legwidth 0];
338  
339   if ($doextrem == 1) {
340 <        # Get min/max image luminance
340 >    # Get min/max image luminance
341      my $cmd1 = 'pextrem -o ' . $picture;
342      my $retval = `$cmd1`;
343      # e.g.
# Line 273 | Line 346 | if ($doextrem == 1) {
346      # 211 202 1.292969e+00 1.308594e+00 1.300781e+00
347  
348      my @extrema = split(/\s/, $retval);
349 <    my $lxmin = $extrema[0] + $legwidth;
350 <    my $ymin = $extrema[1];
351 <    my $rmin = $extrema[2];
279 <    my $gmin = $extrema[3];
280 <    my $bmin = $extrema[4];
281 <    my $lxmax = $extrema[5] + $legwidth;
282 <    my $ymax = $extrema[6];
283 <    my $rmax = $extrema[7];
284 <    my $gmax = $extrema[8];
285 <    my $bmax = $extrema[9];
349 >    my ($lxmin, $ymin, $rmin, $gmin, $bmin, $lxmax, $ymax, $rmax, $gmax, $bmax) = @extrema;
350 >    $lxmin += $legwidth;
351 >    $lxmax += $legwidth;
352  
353 <        # Weighted average of R,G,B
353 >    # Weighted average of R,G,B
354      my $minpos = "$lxmin $ymin";
355      my $minval = ($rmin * .27 + $gmin * .67 + $bmin * .06) * $mult;
356      $minval =~ s/(\.[0-9]{3})[0-9]*/$1/;
291    my $maxpos = "$lxmax $ymax";
357      my $maxval = ($rmax * .27 + $gmax * .67 + $bmax * .06) * $mult;
358      $maxval =~ s/(\.[0-9]{3})[0-9]*/$1/;
359  
360 <        # Create the labels for min/max intensity
361 <    my $minvpic = $td . '/minv.hdr';
362 <    $cmd1 = "psign -s -.15 -a 2 -h 16 $minval > $minvpic";
363 <    system $cmd1;
364 <    my $maxvpic = $td . '/maxv.hdr';
300 <    $cmd1 = "psign -s -.15 -a 2 -h 16 $maxval > $maxvpic";
301 <    system $cmd1;
360 >    # Create the labels for min/max intensity
361 >    my $minvpic = "$td/minv.hdr";
362 >    system "psign -s -.15 -a 2 -h 16 $minval > $minvpic";
363 >    my $maxvpic = "$td/maxv.hdr";
364 >    system "psign -s -.15 -a 2 -h 16 $maxval > $maxvpic";
365  
366 <        # Add extrema labels to command line
367 <    $cmd .= " $minvpic $minpos $maxvpic $maxpos";
366 >    # Add extrema labels to command line
367 >    $cmd .= qq[ $minvpic $minpos $maxvpic $lxmax $ymax];
368   }
369  
370   # Process image and combine with legend

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines