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.17 by greg, Wed Oct 14 02:39:10 2020 UTC vs.
Revision 2.25 by greg, Wed Feb 1 18:18:10 2023 UTC

# Line 4 | Line 4
4   use warnings;
5   use strict;
6   use File::Temp qw/ tempdir /;
7 use POSIX qw/ floor /;
7  
8   my @palettes = ('def', 'spec', 'pm3d', 'hot', 'eco', 'tbo');
9  
# Line 22 | Line 21 | my $picture = '-';
21   my $cpict = '';
22   my $legwidth = 100;            # Legend width and height
23   my $legheight = 200;
24 + my @overlayWH = (0,0);          # Overlay matrix width and height (default = none)
25 + my @overlayRect;                # Overlay rectangle (left, lower, right, upper)
26   my $haszero = 1;               # print 0 in scale for falsecolor images only
27 < my $docont = '';               # Contours: -cl and -cb
27 > my $docont = '';               # Contours: -cl, -cb, and -c0
28   my $doposter = 0;              # Posterization: -cp
29   my $doextrem = 0;              # Don't mark extrema
30   my $needfile = 0;
31 < my $showpal = 0;               # Show availabel colour palettes
31 > my $showpal = 0;               # Show available colour palettes
32  
33 + my @savedARGV = @ARGV;          # Save for final header
34 +
35   while ($#ARGV >= 0) {
36      $_ = shift;
37      # Options with qualifiers
# Line 39 | Line 42 | while ($#ARGV >= 0) {
42      } elsif (m/-m/) {          # Multiplier
43          $mult = shift;
44      } elsif (m/-spec/) {
45 <        die("depricated option '-spec'. Please use '-pal spec' instead.");
45 >        die("depricated option '-spec'. Please use '-pal spec' instead.\n");
46      } elsif (m/-s/) {          # Scale
47          $scale = shift;
48          if ($scale =~ m/[aA].*/) {
# Line 74 | Line 77 | while ($#ARGV >= 0) {
77          $cpict = $picture;
78      } elsif (m/-n/) {          # Number of contour lines
79          $ndivs = shift;
80 +    } elsif (m/-odim$/) {       # Overlay width and height
81 +        $overlayWH[0] = shift;
82 +        $overlayWH[1] = shift;
83 +        $needfile ||= $overlayWH[0] && $overlayWH[1];
84 +    } elsif (m/-orct/) {        # Overlay rectangle
85 +        $overlayRect[0] = shift;
86 +        $overlayRect[1] = shift;
87 +        $overlayRect[2] = shift;
88 +        $overlayRect[3] = shift;
89  
90      # Switches
91      } elsif (m/-cl/) {         # Contour lines
# Line 82 | Line 94 | while ($#ARGV >= 0) {
94      } elsif (m/-cb/) {         # Contour bands
95          $docont = 'b';
96          $haszero = 0;
97 <    } elsif (m/-cp/) {              # Posterize
97 >    } elsif (m/-cp/) {         # Posterize
98          $doposter = 1;
99          $haszero = 0;
100 +    } elsif (m/-c0/) {          # Turn off falsecolor operation
101 +        $docont = '0';
102 +        $legwidth = 0;
103 +        $legheight = 0;
104      } elsif (m/-palettes/) {        # Show all available palettes
105          $scale   = 45824;           # 256 * 179
106          $showpal = 1;
# Line 106 | Line 122 | if (($legwidth <= 20) || ($legheight <= 40)) {
122   # Temporary directory. Will be removed upon successful program exit.
123   my $td = tempdir( CLEANUP => 1 );
124  
125 < if ($needfile == 1 && $picture eq '-') {
125 > if ($needfile && $picture eq '-') {
126      # Pretend that $td/stdin.rad is the actual filename.
127      $picture = "$td/stdin.hdr";
128      open(FHpic, ">$picture") or
# Line 118 | Line 134 | if ($needfile == 1 && $picture eq '-') {
134      close(FHpic);
135  
136      if ($cpict eq '-') {
137 <        $cpict = "$td/stdin.hdr";
137 >        $cpict = $picture;
138      }
139   }
140  
# Line 132 | Line 148 | if ($scale =~ m/[aA].*/) {
148      $scale = $mult / 179 * 10**$LogLmax;
149   }
150  
151 < if ($docont ne '') {
151 > if ($doposter) {
152 >    # -cp -> $doposter = 1
153 >    my $newv = join( "seg2(v)", split("v", $redv) );
154 >    $redv = $newv;
155 >    $newv = join( "seg2(v)", split("v", $bluv) );
156 >    $bluv = $newv;
157 >    $newv = join( "seg2(v)", split("v", $grnv) );
158 >    $grnv = $newv;
159 > } elsif ($docont) {
160      # -cl -> $docont = a
161      # -cb -> $docont = b
162      my $newv = join( "(v-1/ndivs)*ndivs/(ndivs-1)", split("v", $redv) );
# Line 141 | Line 165 | if ($docont ne '') {
165      $bluv = $newv;
166      $newv = join( "(v-1/ndivs)*ndivs/(ndivs-1)", split("v", $grnv) );
167      $grnv = $newv;
144 } elsif ($doposter == 1) {
145    # -cp -> $doposter = 1
146    my $newv = join( "seg2(v)", split("v", $redv) );
147    $redv = $newv;
148    $newv = join( "seg2(v)", split("v", $bluv) );
149    $bluv = $newv;
150    $newv = join( "seg2(v)", split("v", $grnv) );
151    $grnv = $newv;
168   }
169  
170   my $pc0 = "$td/pc0.cal";
# Line 164 | Line 180 | or(a,b) : if(a,a,b);
180   EPS : 1e-7;
181   neq(a,b) : if(a-b-EPS,1,b-a-EPS);
182   btwn(a,x,b) : if(a-x,-1,b-x);
183 < clip(x) : if(x-1,1,if(x,x,0));
183 > clip(x) : min(1,max(x,0));
184   frac(x) : x - floor(x);
185   boundary(a,b) : neq(floor(ndivs*a),floor(ndivs*b));
186 < round(x):if(x-floor(x)-0.5,ceil(x),floor(x));
186 > round(x) : floor(x+.5);
187  
188   spec_red(x) = 1.6*x - .6;
189   spec_grn(x) = if(x-.375, 1.6-1.6*x, 8/3*x);
# Line 223 | Line 239 | tbo_blu(x):interp_tbo(x,tbo_blup) ^ gamma;
239  
240   isconta = if(btwn(1/ndivs/2,v,1+1/ndivs/2),or(boundary(vleft,vright),boundary(vabove,vbelow)),-1);
241   iscontb = if(btwn(1/ndivs/2,v,1+1/ndivs/2),-btwn(.1,frac(ndivs*v),.9),-1);
242 + iscont0 = -1;
243  
244   seg(x)=(floor(v*ndivs)+.5)/ndivs;
245   seg2(x)=(seg(x)-1/ndivs)*ndivs/(ndivs-1);
# Line 253 | Line 270 | vbelow = map(li(1,0,-1)*norm);
270  
271   map(x) = x;
272  
256
273   ra = ri(nfiles);
274   ga = gi(nfiles);
275   ba = bi(nfiles);
# Line 263 | Line 279 | close FHpc1;
279   my $pc0args = "-f $pc0";
280   my $pc1args = "-f $pc1";
281  
282 < if ($showpal == 1) {
282 > if ($showpal) {
283      my $pc = "pcompos -a 1";
284      foreach my $pal (@palettes) {
285          my $fcimg = "$td/$pal.hdr";
286          my $lbimg = "$td/${pal}_label.hdr";
287          system "psign -cb 0 0 0 -cf 1 1 1 -h 20 $pal > $lbimg";
272
288          my $cmd = qq[pcomb $pc0args -e "v=x/256"];
289          $cmd .= qq[ -e "ro=clip(${pal}_red(v));go=clip(${pal}_grn(v));bo=clip(${pal}_blu(v))"];
290          $cmd .= qq[ -x 256 -y 30 > $fcimg];
# Line 280 | Line 295 | if ($showpal == 1) {
295      exit 0;
296   }
297  
298 < # Contours
284 < if ($docont ne '') {
285 <    # -cl -> $docont = a
286 <    # -cb -> $docont = b
287 <    $pc0args .= qq[ -e "in=iscont$docont"];
288 < }
289 <
290 < if ($cpict eq '') {
298 > if ($cpict eq '' && $docont ne '0') {
299      $pc1args .= qq[ -e "ra=0;ga=0;ba=0"];
300   } elsif ($cpict eq $picture) {
301      $cpict = '';
# Line 298 | Line 306 | if ($decades > 0) {
306      $pc1args .= qq[ -e "map(x)=if(x-10^-$decades,log10(x)/$decades+1,0)"];
307   }
308  
309 + # Contours
310 + if ($docont ne '') {
311 +    # -cl -> $docont = a
312 +    # -cb -> $docont = b
313 +    # -c0 -> $docont = FALSE
314 +    $pc0args .= qq[ -e "in=iscont$docont"];
315 + }
316   # Colours in the legend
317   my $scolpic = "$td/scol.hdr";
318  
# Line 306 | Line 321 | my $slabpic = "$td/slab.hdr";
321   my $cmd;
322   if ($legwidth > 0) {
323      # Legend: Create the text labels
324 <    my $sheight = floor($legheight / $ndivs );
325 <    my $theight = floor($legwidth/(8/1.67));
324 >    my $sheight = int($legheight / $ndivs );
325 >    my $theight = int($legwidth/(8/1.67));
326      my $stheight = $sheight <= $theight ? $sheight : $theight;
327 <    my $vlegheight = $sheight * $ndivs * (1+1.5/$ndivs);
313 <    my $text = "$label\n";
327 >    my $vlegheight = int($sheight * $ndivs * (1+1.5/$ndivs));
328      my $tslabpic = "$td/slabT.hdr";
329 <    open PSIGN, "| psign -s -.15 -cf 1 1 1 -cb 0 0 0 -h $stheight > $tslabpic";
316 <    print PSIGN "$text";
317 <    close PSIGN;
329 >    system "psign -s -.15 -cf 1 1 1 -cb 0 0 0 -h $stheight $label > $tslabpic";
330      my $loop = $ndivs+$haszero;
331 <    my $hlegheight = $sheight * ($loop) + $sheight * .5;
331 >    my $hlegheight = int($sheight * ($loop) + $sheight * .5);
332      my $pcompost = qq[pcompos -b 0 0 0 =-0 $tslabpic 0 $hlegheight ];
333      for (my $i=0; $i<$loop; $i++) {
334          my $imap = ($ndivs - $i) / $ndivs;
# Line 326 | Line 338 | if ($legwidth > 0) {
338          } else {
339              $value *= $imap;
340          }
341 <        # Have no more than 3 decimal places
342 <        $value =~ s/(\.[0-9]{$scaledigits})[0-9]*/$1/;
343 <        $text = "$value\n";
341 >        # Limit decimal places
342 >        if ($scaledigits <= 0) {
343 >                $value =~ s/\.[0-9]*//;
344 >        } else {
345 >                $value =~ s/(\.[0-9]{$scaledigits})[0-9]*/$1/;
346 >        }
347          $tslabpic = "$td/slab$i.hdr";
348 <        open PSIGN, "| psign -s -.15 -cf 1 1 1 -cb 0 0 0 -h $stheight > $tslabpic";
349 <        print PSIGN "$text";
335 <        close PSIGN;
336 <        $hlegheight = $sheight * ($loop - $i - 1) + $sheight * .5;
348 >        system "psign -s -.15 -cf 1 1 1 -cb 0 0 0 -h $stheight $value > $tslabpic";
349 >        $hlegheight = int($sheight * ($loop - $i - 1) + $sheight * .5);
350          $pcompost .= qq[=-0 $tslabpic 0 $hlegheight ];
351      }
352      $pcompost .= qq[ > $slabpic];
# Line 356 | Line 369 | if ($legwidth > 0) {
369  
370   # Legend: Invert the text labels (for dropshadow)
371   my $slabinvpic = "$td/slabinv.hdr";
372 < $cmd = qq[pcomb -e "lo=1-gi(1)" $slabpic > $slabinvpic];
360 < system $cmd;
372 > system qq[pcomb -e "lo=1-gi(1)" $slabpic > $slabinvpic];
373  
374 <
363 < my $sh0 = -floor($legheight / $ndivs / 2);
374 > my $sh0 = -int($legheight / $ndivs / 2);
375   if ($haszero < 1) {
376 <    $sh0 = -floor($legheight / ($ndivs)*1.5);
376 >    $sh0 = -int($legheight / ($ndivs)*1.5);
377   }
378  
379   # Command line without extrema
380  
381      $cmd = qq[pcomb $pc0args $pc1args "$picture"];
382      $cmd .= qq[ "$cpict"] if ($cpict);
383 <    $cmd .= qq[ | pcompos -b 0 0 0 $scolpic 0 $sh0 +t .1 $slabinvpic 2 -1 ];
383 >    $cmd .= qq[ | pcompos -h -b 0 0 0 $scolpic 0 $sh0 +t .1 $slabinvpic 2 -1];
384      $cmd .= qq[ -t .5 $slabpic 0 0 - $legwidth 0];
385  
386 < if ($doextrem == 1) {
386 > my $cheight = 32;
387 >
388 > if ($overlayWH[0] && $overlayWH[1]) {
389 >    # Overlay picture matrix values
390 >    my @picWH = split ' ', `getinfo -d < $picture`;
391 >    @picWH = ($picWH[3], $picWH[1]);
392 >    if ($#overlayRect != 3) {
393 >        @overlayRect = (0, 0, @picWH);
394 >    } elsif ($overlayRect[2] <= $overlayRect[0] ||
395 >                $overlayRect[3] <= $overlayRect[1]) {
396 >        die("Illegal overlay rectangle\n");
397 >    }
398 >    # Compute spacing between values
399 >    my @cropWH = ($overlayRect[2]-$overlayRect[0], $overlayRect[3]-$overlayRect[1]);
400 >    my $ohspacing = $cropWH[0] / $overlayWH[0];
401 >    my $ovspacing = $cropWH[1] / $overlayWH[1];
402 >    # Compute character height from spacing
403 >    $cheight = int($ovspacing * 0.67 + 0.5);
404 >    if ($cheight >= 1.67/10 * $ohspacing) {
405 >        $cheight = int(1.67/10 * $ohspacing);
406 >    }
407 >    if ($cheight < 10) {
408 >        die "Overlay matrix spacing too tight\n";
409 >    }
410 >    my $cmd1 = qq[pcompos -x $cropWH[0] -y $cropWH[1] "$picture"] .
411 >                qq[ -$overlayRect[0] -$overlayRect[1]];
412 >    $cmd1 .= qq[ | pfilt -1 -b -x /$cheight -y /$cheight];
413 >    $cmd1 .= qq[ | pfilt -1 -r .5 -x $cropWH[0] -y $cropWH[1]];
414 >    $cmd1 .= qq[ | pvalue -o -h -H -b -d -e $mult];
415 >    # Compute matrix label center positions in subimage
416 >    my @xpos;
417 >    foreach (0 .. ($overlayWH[0]-1)) {
418 >        $xpos[$_] = int($ohspacing * ($_ + 0.5));
419 >    }
420 >    my @ypos;
421 >    foreach (0 .. ($overlayWH[1]-1)) {
422 >        $ypos[$_] = int($ovspacing * ($_ + 0.5));
423 >    }
424 >    open(FHsamp, "$cmd1 |");
425 >    $cmd1 = qq[pcompos -h -b 0 0 0 -x $cropWH[0] -y $cropWH[1]];
426 >    my $pscmd = qq[psign -s -.15 -cf 1 1 1 -cb 0 0 0 -h $cheight];
427 >    for (my $y = 0; $y < $cropWH[1]; $y++) {
428 >        my $ymatch = grep /^$y$/, @ypos;
429 >        my $cmd2 = qq[pcompos -b 0 0 0 -x $cropWH[0]];
430 >        for (my $x = 0; $x < $cropWH[0]; $x++) {
431 >            my $sampv = <FHsamp>;
432 >            next if (! $ymatch);
433 >            next if (! grep /^$x$/, @xpos);
434 >            chomp $sampv;
435 >            # Reformatting assumes %e from pvalue
436 >            $sampv =~ /^\s*([0-9])\.([0-9]+)[eE]([-+]?[0-9]+)$/;
437 >            my $manti = $1;
438 >            my $mantf = $2;
439 >            my $expi = $3;
440 >            if ($expi < -3) {
441 >                # use exponent format
442 >            } elsif ($expi < 0) {
443 >                my $pref = '0.';
444 >                for (my $i = $expi; ++$i < 0; ) {
445 >                        $pref .= '0';
446 >                }
447 >                $sampv = $pref . $manti . $mantf;
448 >            } elsif ($expi < length($mantf)) {
449 >                $sampv = sprintf("%g", $sampv);
450 >            } elsif ($expi <= 6) {
451 >                $sampv = $manti . $mantf;
452 >                for (my $i = $expi - length($mantf); $i-- > 0; ) {
453 >                        $sampv .= '0';
454 >                }
455 >            } # else use exponent format
456 >            $cmd2 .= qq[ =0- "!$pscmd $sampv" $x 0];
457 >        }
458 >        next if (! $ymatch);
459 >        my $rowpic = "$td/mrow$y.hdr";
460 >        system "$cmd2 > $rowpic";
461 >        $cmd1 .= qq[ =-0 $rowpic 0 ] . ($cropWH[1]-1 - $y);
462 >    }
463 >    close(FHsamp);
464 >    my $overpic = "$td/overlay.hdr";
465 >    system "$cmd1 > $overpic";
466 >    my $overinvpic = "$td/overinv.hdr";
467 >    system qq[pcomb -e "lo=1-gi(1)" $overpic > $overinvpic];
468 >    my $xleft = $legwidth + $overlayRect[0];
469 >    my $ybottom = $overlayRect[1];
470 >    $cmd .= qq[ +t .1 $overinvpic $xleft $ybottom];
471 >    # Offset from drop shadow
472 >    $xleft -= 2;
473 >    $ybottom += 1;
474 >    $cmd .= qq[ -t .5 $overpic $xleft $ybottom];
475 > }
476 >
477 > if ($doextrem) {
478      # Get min/max image luminance
479      my $cmd1 = 'pextrem -o ' . $picture;
480      my $retval = `$cmd1`;
# Line 387 | Line 489 | if ($doextrem == 1) {
489      $lxmax += $legwidth;
490  
491      # Weighted average of R,G,B
390    my $minpos = "$lxmin $ymin";
492      my $minval = ($rmin * .27 + $gmin * .67 + $bmin * .06) * $mult;
392    $minval =~ s/(\.[0-9]{$scaledigits})[0-9]*/$1/;
493      my $maxval = ($rmax * .27 + $gmax * .67 + $bmax * .06) * $mult;
494 <    $maxval =~ s/(\.[0-9]{$scaledigits})[0-9]*/$1/;
495 <
494 >    if ($scaledigits <= 0) {
495 >        $minval =~ s/\.[0-9]*//;
496 >        $maxval =~ s/\.[0-9]*//;
497 >    } else {
498 >        $minval =~ s/(\.[0-9]{$scaledigits})[0-9]*/$1/;
499 >        $maxval =~ s/(\.[0-9]{$scaledigits})[0-9]*/$1/;
500 >    }
501      # Create the labels for min/max intensity
502      my $minvpic = "$td/minv.hdr";
503 <    system "psign -s -.15 -a 2 -h 16 $minval > $minvpic";
503 >    system "psign -s -.15 -a 2 -h $cheight $minval > $minvpic";
504      my $maxvpic = "$td/maxv.hdr";
505 <    system "psign -s -.15 -a 2 -h 16 $maxval > $maxvpic";
505 >    system "psign -s -.15 -a 2 -h $cheight $maxval > $maxvpic";
506  
507      # Add extrema labels to command line
508 <    $cmd .= qq[ $minvpic $minpos $maxvpic $lxmax $ymax];
508 >    $cmd .= qq[ =00 $minvpic $lxmin $ymin =00 $maxvpic $lxmax $ymax];
509   }
510  
511 + # Clean up and simplify info header without constituent commands
512 + $cmd .= qq[ | getinfo -r "EXPOSURE" "pcompos " "falsecolor @savedARGV"];
513  
407
408
514   # Process image and combine with legend
515 < system "$cmd";
515 > system $cmd;
516  
517   #EOF

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines