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.4 by greg, Wed Mar 23 21:57:11 2011 UTC vs.
Revision 2.10 by greg, Tue Apr 15 21:34:31 2014 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 $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   my $picture = '-';
21   my $cpict = '';
22 < my $legwidth = 100;   # Legend width and height
22 > my $legwidth = 100;            # Legend width and height
23   my $legheight = 200;
24 < my $docont = '';    # Contours
25 < my $loff = 0;    # Offset to align with values
26 < my $doextrem = 0;    # Don't mark extrema
24 > my $docont = '';               # Contours: -cl and -cb
25 > my $doposter = 0;              # Posterization: -cp
26 > my $loff = 0;                  # Offset to align with values
27 > my $doextrem = 0;              # Don't mark extrema
28   my $needfile = 0;
29 + my $showpal = 0;               # Show availabel colour palettes
30  
31   while ($#ARGV >= 0) {
32 <        # Options with qualifiers
33 <    if ("$ARGV[0]" eq '-lw') {    # Legend width
34 <        $legwidth = $ARGV[1];
35 <        shift @ARGV;
36 <    } elsif ("$ARGV[0]" eq '-lh') {    # Legend height
37 <        $legheight = $ARGV[1];
38 <        shift @ARGV;
39 <    } elsif ("$ARGV[0]" eq '-m') {    # Multiplier
40 <        $mult = $ARGV[1];
41 <        shift @ARGV;
42 <    } elsif ("$ARGV[0]" eq '-s') {    # Scale
43 <        $scale = $ARGV[1];
38 <        shift @ARGV;
32 >    $_ = 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 >    } elsif (m/-spec/) {
41 >        die("depricated option '-spec'. Please use '-pal spec' instead.");
42 >    } elsif (m/-s/) {          # Scale
43 >        $scale = shift;
44          if ($scale =~ m/[aA].*/) {
45              $needfile = 1;
46          }
47 <    } elsif ("$ARGV[0]" eq '-l') {    # Label
48 <        $label = $ARGV[1];
49 <        shift @ARGV;
50 <    } elsif ("$ARGV[0]" eq '-log') {    # Logarithmic mapping
51 <        $decades = $ARGV[1];
52 <        shift @ARGV;
53 <    } elsif ("$ARGV[0]" eq '-r') {
54 <        $redv = $ARGV[1];
55 <        shift @ARGV;
56 <    } elsif ("$ARGV[0]" eq '-g') {
57 <        $grnv = $ARGV[1];
58 <        shift @ARGV;
59 <    } elsif ("$ARGV[0]" eq '-b') {
60 <        $bluv = $ARGV[1];
61 <        shift @ARGV;
62 <    } elsif ("$ARGV[0]" eq '-pal') {
63 <        $redv = "$ARGV[1]_red(v)";
64 <        $grnv = "$ARGV[1]_grn(v)";
65 <        $bluv = "$ARGV[1]_blu(v)";
66 <        shift @ARGV;
67 <    } elsif ("$ARGV[0]" eq '-i') {    # Image for intensity mapping
68 <        $picture = $ARGV[1];
69 <        shift @ARGV;
70 <    } elsif ("$ARGV[0]" eq '-p') {    # Image for background
71 <        $cpict = $ARGV[1];
72 <        shift @ARGV;
73 <    } 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;
47 >    } 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  
75 <        # Switches
76 <    } elsif ("$ARGV[0]" eq '-cl') {    # Contour lines
75 >    # Switches
76 >    } elsif (m/-cl/) {         # Contour lines
77          $docont = 'a';
78          $loff = 0.48;
79 <    } elsif ("$ARGV[0]" eq '-cb') {    # Contour bands
79 >    } elsif (m/-cb/) {         # Contour bands
80          $docont = 'b';
81          $loff = 0.52;
82 <    } elsif ("$ARGV[0]" eq '-e') {
82 >    } elsif (m/-cp/) {              # Posterize
83 >        $doposter = 1;
84 >    } elsif (m/-palettes/) {        # Show all available palettes
85 >        $scale   = 45824;           # 256 * 179
86 >        $showpal = 1;
87 >    } elsif (m/-e/) {
88          $doextrem = 1;
89          $needfile = 1;
90  
91 <        # Oops! Illegal option
91 >    # Oops! Illegal option
92      } else {
93 <        die("bad option \"$ARGV[0]\"\n");
93 >        die("bad option \"$_\"\n");
94      }
91    shift @ARGV;
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 <        # Pretend that $td/stdin.rad is the actual filename.
101 >    # Pretend that $td/stdin.rad is the actual filename.
102      $picture = "$td/stdin.hdr";
103      open(FHpic, ">$picture") or
104              die("Unable to write to file $picture\n");
105 <        # Input is from STDIN: Capture to file.
106 <        while (<>) {
107 <                print FHpic;
108 <        }
105 >    # Input is from STDIN: Capture to file.
106 >    while (<>) {
107 >        print FHpic;
108 >    }
109      close(FHpic);
110  
111 <        if ($cpict eq '-') {
112 <                $cpict =  "$td/stdin.hdr";
113 <        }
111 >    if ($cpict eq '-') {
112 >        $cpict = "$td/stdin.hdr";
113 >    }
114   }
115  
116   # Find a good scale for auto mode.
117   if ($scale =~ m/[aA].*/) {
118 <        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];
118 >    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      $scale = $mult / 179 * 10**$LogLmax;
124   }
125  
# Line 142 | Line 145 | 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 < pm3d_grn(x) = x*x*x ^ gamma;
149 < pm3d_blu(x) = clip(sin(2*PI*x)) ^ gamma;
148 > pm3d_grn(x) = (x*x*x) ^ gamma;
149 > pm3d_blu(x) = clip(sin(2*PI*clip(x))) ^ gamma;
150  
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 + 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   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  
# Line 186 | Line 193 | ro = if(in,clip($redv),ra);
193   go = if(in,clip($grnv),ga);
194   bo = if(in,clip($bluv),ba);
195   EndOfPC0
196 + close FHpc0;
197  
198   my $pc1 = "$td/pc1.cal";
199   open(FHpc1, ">$pc1");
# Line 205 | Line 213 | ra = ri(nfiles);
213   ga = gi(nfiles);
214   ba = bi(nfiles);
215   EndOfPC1
216 + close FHpc1;
217  
218   my $pc0args = "-f $pc0";
219   my $pc1args = "-f $pc1";
220  
221 < # Contour lines or bands
221 > 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   if ($docont ne '') {
240 <    $pc0args .= " -e 'in=iscont$docont'";
240 >    # -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   }
248  
249   if ($cpict eq '') {
250 <    $pc1args .= " -e 'ra=0;ga=0;ba=0'";
250 >    $pc1args .= qq[ -e "ra=0;ga=0;ba=0"];
251   } elsif ($cpict eq $picture) {
252      $cpict = '';
253   }
254  
255   # Logarithmic mapping
256   if ($decades > 0) {
257 <    $pc1args .= " -e 'map(x)=if(x-10^-$decades,log10(x)/$decades+1,0)'";
257 >    $pc1args .= qq[ -e "map(x)=if(x-10^-$decades,log10(x)/$decades+1,0)"];
258   }
259  
260   # Colours in the legend
261   my $scolpic = "$td/scol.hdr";
262 +
263   # Labels in the legend
264   my $slabpic = "$td/slab.hdr";
265   my $cmd;
266  
267   if (($legwidth > 20) && ($legheight > 40)) {
268 <        # Legend: Create the text labels
268 >    # Legend: Create the text labels
269      my $sheight = floor($legheight / $ndivs + 0.5);
270      $legheight = $sheight * $ndivs;
271      $loff = floor($loff * $sheight + 0.5);
272      my $text = "$label";
273      for (my $i=0; $i<$ndivs; $i++) {
274          my $imap = ($ndivs - 0.5 - $i) / $ndivs;
275 <                my $value = $scale;
275 >        my $value = $scale;
276          if ($decades > 0) {
277              $value *= 10**(($imap - 1) * $decades);
278          } else {
279              $value *= $imap;
280          }
281 +
282          # Have no more than 3 decimal places
283          $value =~ s/(\.[0-9]{3})[0-9]*/$1/;
284          $text .= "\n$value";
285      }
286 <    $cmd = "echo '$text' | psign -s -.15 -cf 1 1 1 -cb 0 0 0";
287 <    $cmd .= " -h $sheight > $slabpic";
288 <    system $cmd;
286 >    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  
290 <        # Legend: Create the background colours
291 <    $cmd = "pcomb $pc0args -e 'v=(y+.5)/yres;vleft=v;vright=v'";
292 <    $cmd .= " -e 'vbelow=(y-.5)/yres;vabove=(y+1.5)/yres'";
293 <    $cmd .= " -x $legwidth -y $legheight > $scolpic";
290 >    # Legend: Create the background colours
291 >    $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      system $cmd;
296   } else {
297 <        # Legend is too small to be legible. Don't bother doing one.
297 >    # Legend is too small to be legible. Don't bother doing one.
298      $legwidth = 0;
299      $legheight = 0;
300      $loff = 0;
301 <        # Create dummy colour scale and legend labels so we don't
302 <        # need to change the final command line.
301 >
302 >    # Create dummy colour scale and legend labels so we don't
303 >    # need to change the final command line.
304      open(FHscolpic, ">$scolpic");
305      print FHscolpic "\n-Y 1 +X 1\naaa\n";
306      close(FHscolpic);
# Line 275 | Line 311 | if (($legwidth > 20) && ($legheight > 40)) {
311  
312   # Legend: Invert the text labels (for dropshadow)
313   my $slabinvpic = "$td/slabinv.hdr";
314 < $cmd = "pcomb -e 'lo=1-gi(1)' $slabpic > $slabinvpic";
314 > $cmd = qq[pcomb -e "lo=1-gi(1)" $slabpic > $slabinvpic];
315   system $cmd;
316  
317   my $loff1 = $loff - 1;
318 +
319   # Command line without extrema
320 < $cmd = "pcomb $pc0args $pc1args $picture $cpict";
321 < $cmd .= "| pcompos $scolpic 0 0 +t .1 $slabinvpic 2 $loff1";
322 < $cmd .= " -t .5 $slabpic 0 $loff - $legwidth 0";
320 > $cmd = qq[pcomb $pc0args $pc1args "$picture"];
321 > $cmd .= qq[ "$cpict"] if ($cpict);
322 > $cmd .= qq[ | pcompos $scolpic 0 0 +t .1 $slabinvpic 2 $loff1];
323 > $cmd .= qq[ -t .5 $slabpic 0 $loff - $legwidth 0];
324  
325   if ($doextrem == 1) {
326 <        # Get min/max image luminance
326 >    # Get min/max image luminance
327      my $cmd1 = 'pextrem -o ' . $picture;
328      my $retval = `$cmd1`;
329      # e.g.
# Line 295 | Line 333 | if ($doextrem == 1) {
333  
334      my @extrema = split(/\s/, $retval);
335      my ($lxmin, $ymin, $rmin, $gmin, $bmin, $lxmax, $ymax, $rmax, $gmax, $bmax) = @extrema;
336 <        $lxmin += $legwidth;
337 <        $lxmax += $legwidth;
336 >    $lxmin += $legwidth;
337 >    $lxmax += $legwidth;
338  
339 <        # Weighted average of R,G,B
339 >    # Weighted average of R,G,B
340      my $minpos = "$lxmin $ymin";
341      my $minval = ($rmin * .27 + $gmin * .67 + $bmin * .06) * $mult;
342      $minval =~ s/(\.[0-9]{3})[0-9]*/$1/;
305    my $maxpos = "$lxmax $ymax";
343      my $maxval = ($rmax * .27 + $gmax * .67 + $bmax * .06) * $mult;
344      $maxval =~ s/(\.[0-9]{3})[0-9]*/$1/;
345  
346 <        # Create the labels for min/max intensity
346 >    # Create the labels for min/max intensity
347      my $minvpic = "$td/minv.hdr";
348 <    $cmd1 = "psign -s -.15 -a 2 -h 16 $minval > $minvpic";
312 <    system $cmd1;
348 >    system "psign -s -.15 -a 2 -h 16 $minval > $minvpic";
349      my $maxvpic = "$td/maxv.hdr";
350 <    $cmd1 = "psign -s -.15 -a 2 -h 16 $maxval > $maxvpic";
315 <    system $cmd1;
350 >    system "psign -s -.15 -a 2 -h 16 $maxval > $maxvpic";
351  
352 <        # Add extrema labels to command line
353 <    $cmd .= " $minvpic $minpos $maxvpic $maxpos";
352 >    # Add extrema labels to command line
353 >    $cmd .= qq[ $minvpic $minpos $maxvpic $lxmax $ymax];
354   }
355  
356   # Process image and combine with legend

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines