falsecolor: get latest Radiance HEAD 4 Apr 2013
authorAxel Jacobs <axel@jaloxa.eu>
Tue, 15 Apr 2014 21:13:47 +0100
changeset 75e02e199c8c71
parent 74 196d637b14b5
child 76 c9a4f39c439f
falsecolor: get latest Radiance HEAD 4 Apr 2013
bin/falsecolor.pl
     1.1 --- a/bin/falsecolor.pl	Mon Apr 14 22:21:35 2014 +0100
     1.2 +++ b/bin/falsecolor.pl	Tue Apr 15 21:13:47 2014 +0100
     1.3 @@ -1,131 +1,125 @@
     1.4  #!/usr/bin/perl -w
     1.5 -# RCSid $Id: falsecolor.pl,v 2.4 2011/03/23 21:57:11 greg Exp $
     1.6 +# RCSid $Id: falsecolor.pl,v 2.9 2013/04/04 02:59:20 greg Exp $
     1.7  
     1.8 -######################################################################
     1.9 -#
    1.10 -# Please don't tinker with falsecolor.pl
    1.11 -# This is an old version. The most recent version is in Radiance HEAD.
    1.12 -#
    1.13 -# Axel, Dec 2011
    1.14 -#
    1.15 -######################################################################
    1.16 -
    1.17 +use warnings;
    1.18  use strict;
    1.19  use File::Temp qw/ tempdir /;
    1.20  use POSIX qw/ floor /;
    1.21  
    1.22 -my $mult = 179.0;    # Multiplier. Default W/sr/m2 -> cd/m2
    1.23 -my $label = 'cd/m2';    # Units shown in legend
    1.24 -my $scale = 1000;    # Top of the scale
    1.25 -my $decades = 0;    # Default is linear mapping
    1.26 -my $redv = 'def_red(v)';    # Mapping function for R,G,B
    1.27 -my $grnv = 'def_grn(v)';
    1.28 -my $bluv = 'def_blu(v)';
    1.29 -my $ndivs = 8;    # Number of lines in legend
    1.30 +my @palettes = ('def', 'spec', 'pm3d', 'hot', 'eco');
    1.31 +
    1.32 +my $mult = 179.0;              # Multiplier. Default W/sr/m2 -> cd/m2
    1.33 +my $label = 'cd/m2';           # Units shown in legend
    1.34 +my $scale = 1000;              # Top of the scale
    1.35 +my $decades = 0;               # Default is linear mapping
    1.36 +my $pal = 'def';               # Palette
    1.37 +my $redv = "${pal}_red(v)";    # Mapping functions for R,G,B
    1.38 +my $grnv = "${pal}_grn(v)";
    1.39 +my $bluv = "${pal}_blu(v)";
    1.40 +my $ndivs = 8;                 # Number of lines in legend
    1.41  my $picture = '-';
    1.42  my $cpict = '';
    1.43 -my $legwidth = 100;   # Legend width and height
    1.44 +my $legwidth = 100;            # Legend width and height
    1.45  my $legheight = 200;
    1.46 -my $docont = '';    # Contours
    1.47 -my $loff = 0;    # Offset to align with values
    1.48 -my $doextrem = 0;    # Don't mark extrema
    1.49 +my $docont = '';               # Contours: -cl and -cb
    1.50 +my $doposter = 0;              # Posterization: -cp
    1.51 +my $loff = 0;                  # Offset to align with values
    1.52 +my $doextrem = 0;              # Don't mark extrema
    1.53  my $needfile = 0;
    1.54 +my $showpal = 0;               # Show availabel colour palettes
    1.55  
    1.56  while ($#ARGV >= 0) {
    1.57 -	# Options with qualifiers
    1.58 -    if ("$ARGV[0]" eq '-lw') {    # Legend width
    1.59 -        $legwidth = $ARGV[1];
    1.60 -        shift @ARGV;
    1.61 -    } elsif ("$ARGV[0]" eq '-lh') {    # Legend height
    1.62 -        $legheight = $ARGV[1];
    1.63 -        shift @ARGV;
    1.64 -    } elsif ("$ARGV[0]" eq '-m') {    # Multiplier
    1.65 -        $mult = $ARGV[1];
    1.66 -        shift @ARGV;
    1.67 -    } elsif ("$ARGV[0]" eq '-s') {    # Scale
    1.68 -        $scale = $ARGV[1];
    1.69 -        shift @ARGV;
    1.70 +    $_ = shift;
    1.71 +    # Options with qualifiers
    1.72 +    if (m/-lw/) {              # Legend width
    1.73 +        $legwidth = shift;
    1.74 +    } elsif (m/-lh/) {         # Legend height
    1.75 +        $legheight = shift;
    1.76 +    } elsif (m/-m/) {          # Multiplier
    1.77 +        $mult = shift;
    1.78 +    } elsif (m/-spec/) {
    1.79 +        die("depricated option '-spec'. Please use '-pal spec' instead.");
    1.80 +    } elsif (m/-s/) {          # Scale
    1.81 +        $scale = shift;
    1.82          if ($scale =~ m/[aA].*/) {
    1.83              $needfile = 1;
    1.84          }
    1.85 -    } elsif ("$ARGV[0]" eq '-l') {    # Label
    1.86 -        $label = $ARGV[1];
    1.87 -        shift @ARGV;
    1.88 -    } elsif ("$ARGV[0]" eq '-log') {    # Logarithmic mapping
    1.89 -        $decades = $ARGV[1];
    1.90 -        shift @ARGV;
    1.91 -    } elsif ("$ARGV[0]" eq '-r') {
    1.92 -        $redv = $ARGV[1];
    1.93 -        shift @ARGV;
    1.94 -    } elsif ("$ARGV[0]" eq '-g') {
    1.95 -        $grnv = $ARGV[1];
    1.96 -        shift @ARGV;
    1.97 -    } elsif ("$ARGV[0]" eq '-b') {
    1.98 -        $bluv = $ARGV[1];
    1.99 -        shift @ARGV;
   1.100 -    } elsif ("$ARGV[0]" eq '-pal') {
   1.101 -	$redv = "$ARGV[1]_red(v)";
   1.102 -	$grnv = "$ARGV[1]_grn(v)";
   1.103 -	$bluv = "$ARGV[1]_blu(v)";
   1.104 -	shift @ARGV;
   1.105 -    } elsif ("$ARGV[0]" eq '-i') {    # Image for intensity mapping
   1.106 -        $picture = $ARGV[1];
   1.107 -        shift @ARGV;
   1.108 -    } elsif ("$ARGV[0]" eq '-p') {    # Image for background
   1.109 -        $cpict = $ARGV[1];
   1.110 -        shift @ARGV;
   1.111 -    } elsif ("$ARGV[0]" eq '-ip' || "$ARGV[0]" eq '-pi') {
   1.112 -        $picture = $ARGV[1];
   1.113 -        $cpict = $ARGV[1];
   1.114 -        shift @ARGV;
   1.115 -    } elsif ("$ARGV[0]" eq '-n') {    # Number of contour lines
   1.116 -        $ndivs = $ARGV[1];
   1.117 -        shift @ARGV;
   1.118 +    } elsif (m/-l$/) {         # Label
   1.119 +        $label = shift;
   1.120 +    } elsif (m/-log/) {        # Logarithmic mapping
   1.121 +        $decades = shift;
   1.122 +    } elsif (m/-r/) {          # Custom palette functions for R,G,B
   1.123 +        $redv = shift;
   1.124 +    } elsif (m/-g/) {
   1.125 +        $grnv = shift;
   1.126 +    } elsif (m/-b/) {
   1.127 +        $bluv = shift;
   1.128 +    } elsif (m/-pal$/) {        # Color palette
   1.129 +        $pal = shift;
   1.130 +        if (! grep $_ eq $pal, @palettes) {
   1.131 +            die("invalid palette '$pal'.\n");
   1.132 +        }
   1.133 +        $redv = "${pal}_red(v)";
   1.134 +        $grnv = "${pal}_grn(v)";
   1.135 +        $bluv = "${pal}_blu(v)";
   1.136 +    } elsif (m/-i$/) {          # Image for intensity mapping
   1.137 +        $picture = shift;
   1.138 +    } elsif (m/-p$/) {         # Image for background
   1.139 +        $cpict = shift;
   1.140 +    } elsif (m/-ip/ || m/-pi/) {
   1.141 +        $picture = shift;
   1.142 +        $cpict = $picture;
   1.143 +    } elsif (m/-n/) {          # Number of contour lines
   1.144 +        $ndivs = shift;
   1.145  
   1.146 -	# Switches
   1.147 -    } elsif ("$ARGV[0]" eq '-cl') {    # Contour lines
   1.148 +    # Switches
   1.149 +    } elsif (m/-cl/) {         # Contour lines
   1.150          $docont = 'a';
   1.151          $loff = 0.48;
   1.152 -    } elsif ("$ARGV[0]" eq '-cb') {    # Contour bands
   1.153 +    } elsif (m/-cb/) {         # Contour bands
   1.154          $docont = 'b';
   1.155          $loff = 0.52;
   1.156 -    } elsif ("$ARGV[0]" eq '-e') {
   1.157 +    } elsif (m/-cp/) {              # Posterize
   1.158 +        $doposter = 1;
   1.159 +    } elsif (m/-palettes/) {        # Show all available palettes
   1.160 +        $scale   = 45824;           # 256 * 179
   1.161 +        $showpal = 1;
   1.162 +    } elsif (m/-e/) {
   1.163          $doextrem = 1;
   1.164          $needfile = 1;
   1.165  
   1.166 -	# Oops! Illegal option
   1.167 +    # Oops! Illegal option
   1.168      } else {
   1.169 -        die("bad option \"$ARGV[0]\"\n");
   1.170 +        die("bad option \"$_\"\n");
   1.171      }
   1.172 -    shift @ARGV;
   1.173  }
   1.174  
   1.175  # Temporary directory. Will be removed upon successful program exit.
   1.176  my $td = tempdir( CLEANUP => 1 );
   1.177  
   1.178  if ($needfile == 1 && $picture eq '-') {
   1.179 -	# Pretend that $td/stdin.rad is the actual filename.
   1.180 +    # Pretend that $td/stdin.rad is the actual filename.
   1.181      $picture = "$td/stdin.hdr";
   1.182      open(FHpic, ">$picture") or
   1.183              die("Unable to write to file $picture\n");
   1.184 -	# Input is from STDIN: Capture to file.
   1.185 -	while (<>) {
   1.186 -		print FHpic;
   1.187 -	}
   1.188 +    # Input is from STDIN: Capture to file.
   1.189 +    while (<>) {
   1.190 +        print FHpic;
   1.191 +    }
   1.192      close(FHpic);
   1.193  
   1.194 -	if ($cpict eq '-') {
   1.195 -		$cpict =  "$td/stdin.hdr";
   1.196 -	}
   1.197 +    if ($cpict eq '-') {
   1.198 +        $cpict = "$td/stdin.hdr";
   1.199 +    }
   1.200  }
   1.201  
   1.202  # Find a good scale for auto mode.
   1.203  if ($scale =~ m/[aA].*/) {
   1.204 -	my @histo = split(/\s/, `phisto $picture| tail -2`);
   1.205 -	# e.g. $ phisto tests/richmond.hdr| tail -2
   1.206 -	# 3.91267	14
   1.207 -	# 3.94282	6
   1.208 -	my $LogLmax = $histo[0];
   1.209 +    my @histo = split(/\s/, `phisto $picture| tail -2`);
   1.210 +    # e.g. $ phisto tests/richmond.hdr| tail -2
   1.211 +    # 3.91267	14
   1.212 +    # 3.94282	6
   1.213 +    my $LogLmax = $histo[0];
   1.214      $scale = $mult / 179 * 10**$LogLmax;
   1.215  }
   1.216  
   1.217 @@ -151,13 +145,17 @@
   1.218  spec_blu(x) = 1 - 8/3*x;
   1.219  
   1.220  pm3d_red(x) = sqrt(x) ^ gamma;
   1.221 -pm3d_grn(x) = x*x*x ^ gamma;
   1.222 -pm3d_blu(x) = clip(sin(2*PI*x)) ^ gamma;
   1.223 +pm3d_grn(x) = (x*x*x) ^ gamma;
   1.224 +pm3d_blu(x) = clip(sin(2*PI*clip(x))) ^ gamma;
   1.225  
   1.226  hot_red(x) = clip(3*x) ^ gamma;
   1.227  hot_grn(x) = clip(3*x - 1) ^ gamma;
   1.228  hot_blu(x) = clip(3*x - 2) ^ gamma;
   1.229  
   1.230 +eco_red(x) = clip(2*x) ^ gamma;
   1.231 +eco_grn(x) = clip(2*(x-0.5)) ^ gamma;
   1.232 +eco_blu(x) = clip(2*(0.5-x)) ^ gamma;
   1.233 +
   1.234  interp_arr2(i,x,f):(i+1-x)*f(i)+(x-i)*f(i+1);
   1.235  interp_arr(x,f):if(x-1,if(f(0)-x,interp_arr2(floor(x),x,f),f(f(0))),f(1));
   1.236  
   1.237 @@ -195,6 +193,7 @@
   1.238  go = if(in,clip($grnv),ga);
   1.239  bo = if(in,clip($bluv),ba);
   1.240  EndOfPC0
   1.241 +close FHpc0;
   1.242  
   1.243  my $pc1 = "$td/pc1.cal";
   1.244  open(FHpc1, ">$pc1");
   1.245 @@ -214,66 +213,94 @@
   1.246  ga = gi(nfiles);
   1.247  ba = bi(nfiles);
   1.248  EndOfPC1
   1.249 +close FHpc1;
   1.250  
   1.251  my $pc0args = "-f $pc0";
   1.252  my $pc1args = "-f $pc1";
   1.253  
   1.254 -# Contour lines or bands
   1.255 +if ($showpal == 1) {
   1.256 +    my $pc = "pcompos -a 1";
   1.257 +    foreach my $pal (@palettes) {
   1.258 +        my $fcimg = "$td/$pal.hdr";
   1.259 +        my $lbimg = "$td/${pal}_label.hdr";
   1.260 +        system "psign -cb 0 0 0 -cf 1 1 1 -h 20 $pal > $lbimg";
   1.261 +
   1.262 +        my $cmd = qq[pcomb $pc0args -e "v=x/256"];
   1.263 +        $cmd .= qq[ -e "ro=clip(${pal}_red(v));go=clip(${pal}_grn(v));bo=clip(${pal}_blu(v))"];
   1.264 +        $cmd .= qq[ -x 256 -y 30 > $fcimg];
   1.265 +        system "$cmd";
   1.266 +        $pc .= " $fcimg $lbimg";
   1.267 +    }
   1.268 +    system "$pc";
   1.269 +    exit 0;
   1.270 +}
   1.271 +
   1.272 +# Contours
   1.273  if ($docont ne '') {
   1.274 -    $pc0args .= " -e 'in=iscont$docont'";
   1.275 +    # -cl -> $docont = a
   1.276 +    # -cb -> $docont = b
   1.277 +    $pc0args .= qq[ -e "in=iscont$docont"];
   1.278 +} elsif ($doposter == 1) {
   1.279 +    # -cp -> $doposter = 1
   1.280 +    $pc0args .= qq[ -e "ro=${pal}_red(seg(v));go=${pal}_grn(seg(v));bo=${pal}_blu(seg(v))"];
   1.281 +    $pc0args .= q[ -e "seg(x)=(floor(v*ndivs)+.5)/ndivs"];
   1.282  }
   1.283  
   1.284  if ($cpict eq '') {
   1.285 -    $pc1args .= " -e 'ra=0;ga=0;ba=0'";
   1.286 +    $pc1args .= qq[ -e "ra=0;ga=0;ba=0"];
   1.287  } elsif ($cpict eq $picture) {
   1.288      $cpict = '';
   1.289  }
   1.290  
   1.291  # Logarithmic mapping
   1.292  if ($decades > 0) {
   1.293 -    $pc1args .= " -e 'map(x)=if(x-10^-$decades,log10(x)/$decades+1,0)'";
   1.294 +    $pc1args .= qq[ -e "map(x)=if(x-10^-$decades,log10(x)/$decades+1,0)"];
   1.295  }
   1.296  
   1.297  # Colours in the legend
   1.298  my $scolpic = "$td/scol.hdr";
   1.299 +
   1.300  # Labels in the legend
   1.301  my $slabpic = "$td/slab.hdr";
   1.302  my $cmd;
   1.303  
   1.304  if (($legwidth > 20) && ($legheight > 40)) {
   1.305 -	# Legend: Create the text labels
   1.306 +    # Legend: Create the text labels
   1.307      my $sheight = floor($legheight / $ndivs + 0.5);
   1.308      $legheight = $sheight * $ndivs;
   1.309      $loff = floor($loff * $sheight + 0.5);
   1.310      my $text = "$label";
   1.311      for (my $i=0; $i<$ndivs; $i++) {
   1.312          my $imap = ($ndivs - 0.5 - $i) / $ndivs;
   1.313 -		my $value = $scale;
   1.314 +        my $value = $scale;
   1.315          if ($decades > 0) {
   1.316              $value *= 10**(($imap - 1) * $decades);
   1.317          } else {
   1.318              $value *= $imap;
   1.319          }
   1.320 +
   1.321          # Have no more than 3 decimal places
   1.322          $value =~ s/(\.[0-9]{3})[0-9]*/$1/;
   1.323          $text .= "\n$value";
   1.324      }
   1.325 -    $cmd = "echo '$text' | psign -s -.15 -cf 1 1 1 -cb 0 0 0";
   1.326 -    $cmd .= " -h $sheight > $slabpic";
   1.327 -    system $cmd;
   1.328 +    open PSIGN, "| psign -s -.15 -cf 1 1 1 -cb 0 0 0 -h $sheight > $slabpic";
   1.329 +    print PSIGN "$text\n";
   1.330 +    close PSIGN;
   1.331  
   1.332 -	# Legend: Create the background colours
   1.333 -    $cmd = "pcomb $pc0args -e 'v=(y+.5)/yres;vleft=v;vright=v'";
   1.334 -    $cmd .= " -e 'vbelow=(y-.5)/yres;vabove=(y+1.5)/yres'";
   1.335 -    $cmd .= " -x $legwidth -y $legheight > $scolpic";
   1.336 +    # Legend: Create the background colours
   1.337 +    $cmd = qq[pcomb $pc0args];
   1.338 +    $cmd .= q[ -e "v=(y+.5)/yres;vleft=v;vright=v"];
   1.339 +    $cmd .= q[ -e "vbelow=(y-.5)/yres;vabove=(y+1.5)/yres"];
   1.340 +    $cmd .= qq[ -x $legwidth -y $legheight > $scolpic];
   1.341      system $cmd;
   1.342  } else {
   1.343 -	# Legend is too small to be legible. Don't bother doing one.
   1.344 +    # Legend is too small to be legible. Don't bother doing one.
   1.345      $legwidth = 0;
   1.346      $legheight = 0;
   1.347      $loff = 0;
   1.348 -	# Create dummy colour scale and legend labels so we don't
   1.349 -	# need to change the final command line.
   1.350 +
   1.351 +    # Create dummy colour scale and legend labels so we don't
   1.352 +    # need to change the final command line.
   1.353      open(FHscolpic, ">$scolpic");
   1.354      print FHscolpic "\n-Y 1 +X 1\naaa\n";
   1.355      close(FHscolpic);
   1.356 @@ -284,17 +311,18 @@
   1.357  
   1.358  # Legend: Invert the text labels (for dropshadow)
   1.359  my $slabinvpic = "$td/slabinv.hdr";
   1.360 -$cmd = "pcomb -e 'lo=1-gi(1)' $slabpic > $slabinvpic";
   1.361 +$cmd = qq[pcomb -e "lo=1-gi(1)" $slabpic > $slabinvpic];
   1.362  system $cmd;
   1.363  
   1.364  my $loff1 = $loff - 1;
   1.365 +
   1.366  # Command line without extrema
   1.367 -$cmd = "pcomb $pc0args $pc1args $picture $cpict";
   1.368 -$cmd .= "| pcompos $scolpic 0 0 +t .1 $slabinvpic 2 $loff1";
   1.369 -$cmd .= " -t .5 $slabpic 0 $loff - $legwidth 0";
   1.370 +$cmd = qq[pcomb $pc0args $pc1args $picture $cpict];
   1.371 +$cmd .= qq[ | pcompos $scolpic 0 0 +t .1 $slabinvpic 2 $loff1];
   1.372 +$cmd .= qq[ -t .5 $slabpic 0 $loff - $legwidth 0];
   1.373  
   1.374  if ($doextrem == 1) {
   1.375 -	# Get min/max image luminance
   1.376 +    # Get min/max image luminance
   1.377      my $cmd1 = 'pextrem -o ' . $picture;
   1.378      my $retval = `$cmd1`;
   1.379      # e.g.
   1.380 @@ -304,27 +332,24 @@
   1.381  
   1.382      my @extrema = split(/\s/, $retval);
   1.383      my ($lxmin, $ymin, $rmin, $gmin, $bmin, $lxmax, $ymax, $rmax, $gmax, $bmax) = @extrema;
   1.384 -	$lxmin += $legwidth;
   1.385 -	$lxmax += $legwidth;
   1.386 +    $lxmin += $legwidth;
   1.387 +    $lxmax += $legwidth;
   1.388  
   1.389 -	# Weighted average of R,G,B
   1.390 +    # Weighted average of R,G,B
   1.391      my $minpos = "$lxmin $ymin";
   1.392      my $minval = ($rmin * .27 + $gmin * .67 + $bmin * .06) * $mult;
   1.393      $minval =~ s/(\.[0-9]{3})[0-9]*/$1/;
   1.394 -    my $maxpos = "$lxmax $ymax";
   1.395      my $maxval = ($rmax * .27 + $gmax * .67 + $bmax * .06) * $mult;
   1.396      $maxval =~ s/(\.[0-9]{3})[0-9]*/$1/;
   1.397  
   1.398 -	# Create the labels for min/max intensity
   1.399 +    # Create the labels for min/max intensity
   1.400      my $minvpic = "$td/minv.hdr";
   1.401 -    $cmd1 = "psign -s -.15 -a 2 -h 16 $minval > $minvpic";
   1.402 -    system $cmd1;
   1.403 +    system "psign -s -.15 -a 2 -h 16 $minval > $minvpic";
   1.404      my $maxvpic = "$td/maxv.hdr";
   1.405 -    $cmd1 = "psign -s -.15 -a 2 -h 16 $maxval > $maxvpic";
   1.406 -    system $cmd1;
   1.407 +    system "psign -s -.15 -a 2 -h 16 $maxval > $maxvpic";
   1.408  
   1.409 -	# Add extrema labels to command line
   1.410 -    $cmd .= " $minvpic $minpos $maxvpic $maxpos";
   1.411 +    # Add extrema labels to command line
   1.412 +    $cmd .= qq[ $minvpic $minpos $maxvpic $lxmax $ymax];
   1.413  }
   1.414  
   1.415  # Process image and combine with legend