#!/usr/bin/perl

use Gimp::Feature 'pdl';
use Gimp 1.1;
use Gimp::Fu;
use PDL::LiteF;

# convert to greyscale. could be improved, but should still be fast!
sub togrey {
   my $pdl = shift;
   $pdl->convert(ushort);
   $pdl=$pdl->inner(pdl[54,183,18])/256;
   $pdl->convert(byte);
   $pdl;
}

register "map_to_gradient",
         "map grayscale values to gradient",
         "Map all the pixels to the colours of a gradient according to their greyscale value.",
         "Marc Lehmann",
         "Marc Lehmann <pcg\@goof.com>",
         "19990802",
         N_"<Image>/Filters/Colors/Map To Gradient...",
         "RGB*, GRAY",	
         [
          [PF_GRADIENT,	"gradient",	"The gradient to map to"],
         ],
         sub {
   my($image,$drawable,$gradient)=@_;

   # 5.004 has problems with overlaying functions
   Gimp->progress_init ("Mapping to '$gradient'", -1);

   my $grad = pdl byte, map $_*255, @{(Gimp->gradients_get_gradient_data($gradient,256))[1]};
   $grad->reshape(4,256);

   my $alpha = $drawable->has_alpha;

   $grad = $grad->slice('0:-2') unless $alpha;
   $grad = togrey($grad)->dummy(0) unless $drawable->is_rgb;

   my $depth = ($grad->dims)[0]; # precalculcate
   $grad = $grad->xchg(0,1); # this form is later needed in index, so do it now

   my @bounds = $drawable->bounds;
   {
      my $src = new PixelRgn ($drawable,@bounds,0,0);
      my $dst = new PixelRgn ($drawable,@bounds,1,1);

      my $iter = Gimp->pixel_rgns_register($src,$dst);
      my $area = $bounds[2]*$bounds[3];
      my $progress = 0;

      do {
         my $data = $src->data;
         $data = $data->slice("0:-2") if $alpha; # get rid of alpha
         $data = $src->bpp > 2 ? togrey($data) : $data->clump(2);

         # now map from grey values to gradient
         $dst->data( index($grad,$data->dummy(0,$depth)) );

         $progress += ($src->w*$src->h)/$area;
         Gimp->progress_update ($progress);
      } while (Gimp->pixel_rgns_process ($iter));
   }
   Gimp->progress_update (1);

   $drawable->merge_shadow (1);
   $drawable->update (@bounds);

   ();
};

exit main;