Graphics-HotMap

 view release on metacpan or  search on metacpan

lib/Graphics/HotMap.pm  view on Meta::CPAN

         zoneC => {
            layerName => '40_anotherLayer',
            coordonates => [2,10,3,12],
            border => 1,
            text => 'green',
            textSize => 8,
            textColor => 'white',
         },
         zoneD => {
            layerName => '40_anotherLayer',
            coordonates => [3,10,4,12],
            border => 1,
            text => 'cyan',
            textSize => 8,
            textColor => 'white',
         },
      },
      points => {
         '30_anotherLayer' => [
            [8,5,46],
            [10,9,22],
         ],
         '10_back' => [
            [13,1,50],
         ],
         '40_anotherLayer' => [
            [0,10,1],
            [1,10,2],
            [2,10,3],
            [3,10,4],
         ],
      },
   );

   # ..., and import/add it
   $hotMap->addConfs(\%other);

   # Run the interpolation and generate and image
   $hotMap->genImage;

   # Save the image a a PNG file
   $hotMap->genImagePng('MyTest.png');

   # print the text representation of the map
   print $hotMap->toString('floor') if $hotMap->scale < 3;

=head1 DESCRIPTION

Generate thermographic images from a few know points. Others values are interpolated. Graphics::HotMap use PDL to work on matrix.
PDL can compute very very large matrix in a few seconds.

See L<http://kumy.org/HotMap/HotMap.png>

=head2 FUNCTIONS

=over 4

=cut

use Data::Dumper;
use Image::Magick;
use Math::Gradient qw(multi_array_gradient);
use PDL;
use PDL::NiceSlice;
use PDL::IO::Pic;
use POSIX qw(strftime);
use File::Temp qw/ :POSIX /;
use File::Temp qw/ tempfile tempdir /;

use constant {
   PALETTE_SLICE => 35,
};

our $VERSION = '0.0001';

=item new(<HASH>)

=for ref

Construct and return a new HotMap Object;

=for usage

   Graphics::HotMap->new(
      outfileGif        => <File path>, # file to write GIF
      outfilePng        => <File path>, # file to write PNG
      legend            => [0|1],       # activate lengend
      legendNbGrad      => <number>,    # Number a graduation
      cross             => <bool>,      # activate crossing of known values
      crossValues       => <bool>,      # activate values printing whith cross
      minValue          => <number>,    # minimum value
      maxValue          => <number>,    # maximum value
      font              => <path to font file>,
      fontSize          => <number>,    # font size
      scale             => <number>,    # scale values and coordonates
      sizeX             => <number>,    # X size
      sizeY             => <number>,    # Y size
   );

=for exemple 

   my $hotMap = Graphics::HotMap->new(
      sizeX    => 10, 
      sizeY    => 10, 
      minValue => 1,
      maxvalue => 50,
   );


=cut

sub new {
   my ($class, %params) = (@_);
   my $self={};
   $self->{_outfileGif}   = $params{outfileGif}   || undef;
   $self->{_outfilePng}   = $params{outfilePng}   || undef;
   $self->{_legend}       = $params{legend}       || 0;
   $self->{_legendNbGrad} = $params{legendNbGrad} || 7;
   $self->{_crossMark}    = $params{cross}        || 0;
   $self->{_crossMarkTemp}= $params{crossTemp}    || 0;
   #$self->{_minValue}     = $params{minValue}     || 0;

lib/Graphics/HotMap.pm  view on Meta::CPAN

   foreach my $layer (sort keys %{$self->{_knownPoints}}) {
      my ($d0,$d1) = whichND $self->{_knownPoints}{$layer};
      my $nbValues = nelem($d0);
      for (0..$nbValues-1) {
         next unless (
               defined $self->{_layers}{$layer}{visibility} && 
               $self->{_layers}{$layer}{visibility}
               );
         $self->_drawMark(
               $im,
               $d0(($_)),
               $d1(($_)),
               $self->{_knownPoints}{$layer}->at($d0(($_)),$d1(($_))),
               $self->{_gradient}{$self->{_layers}{$layer}{gradientName}}{unit}
               );
      }
   }
}

=for comment
Internal function for writing timestamp on the image

=cut

sub _drawTime {
   my $self = shift;
   my $im = shift;

   my ($time, $x, $y) = @{$self->{_horodatage}};
   return unless $time;
   $self->addText ( {
         x => $x,
         y => $y,
         text => strftime ("%d-%m-%Y %H:%M:%S", localtime $time),
         } );
}

=for comment
generate text on the image

=cut

sub _genText {
   my $self = shift;
   my ($im) = @_;

   foreach my $text (@{$self->{_text}}) {
      $self->_printText($im, $text);
   }

}

=for comment
generate the image from the interpolated map.

=cut

sub _genPicture {
   my $self = shift;
   my $image = $self->{_im} = new Image::Magick();

# write a temporary image of the piddle
   my $imag =  byte $self->{_mapPoints};
   my $tmpName = tmpnam().'.png';
   #eval { $self->{_hotMap}->genImage };
   #print STDERR "error: _genTemperatureImage: $@" if $@;
   my $cptLoop = 0;
   do {
      eval {$imag->wpic($tmpName, { LUT => $self->{_gradient}{colors} }); };
      ++$cptLoop;
   } while ($@ && $cptLoop < 10);

   if ($cptLoop > 2) {
   	print "ARgh ! Function: _genPicture; nbErr for wpic:$cptLoop\n";
	exit;
   }

# read the temporary File in PerlMagick
   my $status = $image->ReadImage($tmpName);
   warn $status if $status;
   unlink $tmpName;

# Flip the image
   my $im = $image;
   #my $im = $image->[0];
   $im->Flip;

# Gen CrossMarks
   $self->_genCrossMark($im) if $self->{_crossMark};
# Draw time on image
   $self->_drawTime($im) if $self->{_horodatage}[0];
# Draw texts
   $self->_genText($im);

# Gen legend in piddle
   $self->_genLegende($im) if $self->{_legend};
}

=for comment
Really compute the interpolation from known points.

=cut

sub _pdlDegrad {
   my $self = shift;
   my ($input, $output, $sliceColors, $gradientName) = @_;

   my ($d0,$d1) = whichND $input;
   my $nbValues = nelem($d0);
   my $norm = pdl->zeroes($input->dims);
   $output .= 0;

   my $t0r2;
   my $t0r2inv;

   if ($nbValues > 1) {
       for (0..$nbValues-1) {
           my $indice = $_;
           $t0r2 = $input->rvals({ center=>[$d0($indice), $d1($indice)], squared=>1 } );
           $t0r2->where($t0r2==0) .= -1;

lib/Graphics/HotMap.pm  view on Meta::CPAN

   $self->_genPicture;
}

=for comment

This function will write image to disk.

=cut

sub _saveImg {
   my $self = shift;
   my ($outfile, $im) = @_;

   print $im->Write(filename=>$outfile); #, compression=>'JPEG', type => 'Palette');
}

=item genImagePng()

=for ref 

Write a PNG image from the interpolated table.

=for exemple

   $hotMap->genImagePng('<path_to_png'>);

=cut

sub genImagePng {
   my $self = shift;
   my $fileName = shift || $self->{_outfilePng} || die "No output PNG specified";
   $self->_saveImg($fileName,$self->{_im});
   return {
        width    => $self->{_im}->Get('width'),
        height   => $self->{_im}->Get('height'),
        filesize => $self->{_im}->Get('filesize'),
        mime     => $self->{_im}->Get('mime'),
        image    => $self->{_im},
        };
}

=item genImageGif()

=for ref 

Add a GIF image to the annimation from the interpolated table.

=for exemple

   $hotMap->genImageGif('<path_to_gif'>);

=cut

sub genImageGif {
   my $self = shift;
   my $fileName = shift || $self->{_outfileGif} || die "No output GIF specified";
   my $image = shift;
   my $im = $self->{_im};

   unless (defined $image) {
      $image = new Image::Magick(size => "$self->{_mapSize}{x}x$self->{_mapSize}{y}");
      $image->Read($fileName);
   }
   $image->Set(magick=>'GIF', loop=> 100);
   $im->Set(magick=>'GIF', delay=>100);
   push (@$image, $im);
   $self->_saveImg($fileName, $image);
   return {
        width    => $image->Get('width'),
        height   => $image->Get('height'),
        filesize => $image->Get('filesize'),
        mime     => $image->Get('mime'),
        image    => $image,
        };
}

=back

=head1 SEE ALSO

PDL

Math::Gradient

=head1 AUTHOR

Mathieu Alorent (cpan@kumy.net)

=cut

1;