#!/usr/bin/perl -w

# Use the natural logarithm function to construct a
# color palette table (cpt) for use with grdimage and
# other Generic Mapping Tools (GMT) programs.
#
# Norman Kuring		 2-Feb-2001	Original development
# Norman Kuring		17-Apr-2007	Use a PPM LUT to add color.

my $usage = <<"--";
Usage:
$0 minimum maximum ppmlut
where minimum and maximum specify the range of values to be
represented by the color table and ppmlut names a PPM color map file.

The color palette table will be written to standard output.
--

@ARGV == 3 or die $usage;
my ($min,$max,$ppmlut) = @ARGV;

$min < $max or die $usage,
               "\nThe minimum value must be less than the maximum value.\n";
$min > 0    or die $usage,
               "\nThe minimum value must be greater than zero.\n";

my $h = parse_pnm_header($ppmlut) or die "Error reading $ppmlut ($!)";
$h->{magic} eq 'P6' or die "A binary PPM file is required\n";
$h->{width}*$h->{height} == 256 or die "PPM file should contain 256 colors\n";

$logmaxmin = log($max/$min);

open F,$ppmlut or die "Could not open $ppmlut ($!)";
seek F,$h->{hdrlen},0 or die "Could not skip header of  $ppmlut ($!)";
my @lut;
for(my $i=0; $i<256; $i++){
  my $rgb;
  read(F,$rgb,3) == 3 or die "Error reading $ppmlut ($!)";
  my ($r,$g,$b) = unpack "CCC",$rgb;
  push @lut,"$r $g $b";
}
close F;

my $lower = $min;
my $i;
for($i=1; $i<256; $i++){
  my $upper = $min * exp($i * $logmaxmin / 255);
  print "$lower ",$lut[$i-1]," $upper $lut[$i]\n";
  $lower = $upper;
}

print <<"--";	# Output the foreground, background and not-a-number colors.
F 255 255 255
B 0 0 0
N 0 0 0
--



sub parse_pnm_header{
  my $pnmfile = shift;
  my $h;
  open F,$pnmfile or return undef;
  my $bytes;
  read F,$bytes,4096 or return undef;
  close F;
  $bytes =~ /^P[1-6][\s#]/ or return undef;
  my $b = $bytes;       # Keep a pristine copy to get the unmunged header from.
  $bytes =~ s/#.*/' ' x length $&/emg;  # Replace comments with whitespace.
  ($h->{magic},$h->{width},$h->{height},$h->{maxval}) = split ' ', $bytes;
  if($h->{magic} eq 'P1' || $h->{magic} eq 'P4'){
    $h->{maxval} = 1;
    $bytes =~ /$h->{magic}\s+$h->{width}\s+$h->{height}\s/;
    $h->{hdrlen} = length $&;
  }
  else{
    $bytes =~ /$h->{magic}\s+$h->{width}\s+$h->{height}\s+$h->{maxval}\s/;
    $h->{hdrlen} = length $&;
  }
  $h->{header} = substr $b,0,$h->{hdrlen};
  $h->{header} =~ s/\s$/\n/;
  $h;
}
