Image-Heatmap

 view release on metacpan or  search on metacpan

Makefile.PL  view on Meta::CPAN

use 5.008008;
use ExtUtils::MakeMaker;
                                               
WriteMakefile(
    NAME              => 'Image::Heatmap',
    VERSION_FROM      => 'lib/Image/Heatmap.pm',
    PREREQ_PM         => {
        'Image::Magick' => 0,
        'File::Find'    => 0,
    }, 
);

lib/Image/Heatmap.pm  view on Meta::CPAN

package Image::Heatmap;

use strict;
use warnings;

use Image::Magick;

our $VERSION = join( '.', 0, sprintf( '%03d', map{ $_ - 47 + 500 } ( '$Rev: 112 $' =~ /(\d+)/g ) ) ); 
our $DEBUG = 0;

use constant {
    TRANSPARENCY_V1 => 0x1,
    TRANSPARENCY_V2 => 0x2,
};

sub new {

lib/Image/Heatmap.pm  view on Meta::CPAN

    my ( $self ) = @_;

    if ( my $error = Image::Heatmap::private::validate($self) ) {
        Image::Heatmap::private::throw($error);
    }

    my $max_rep = 0;

    my $width  = $self->width();
    my $height = $self->height();
    my $map    = Image::Magick->new();
    $map->Read( $self->map() );
    $self->image_width( $map->Get('width') );
    $self->image_height( $map->Get('height') );

    # If there is no width/height defined then we will default
    # to what the image is defined to.  We will trust the implementor
    # of this module knows what they're doing, otherwise.
    unless ( $width && $height ) {
        $width  = $self->image_width();
        $height = $self->image_height();

lib/Image/Heatmap.pm  view on Meta::CPAN

    foreach my $child_num ( 1 .. $kids ) {
        $children[ $child_num - 1 ] = Image::Heatmap::private::distribute_work($self);

        Image::Heatmap::private::throw(
            'Error when generating sub-process'
        ) unless ( defined( $children[-1] ) );

        unless ( $children[-1] ) {

            note("Resize -geometry ${x_canvas}x${y_canvas}");
            my $child_layer = Image::Magick->new( size => "${x_canvas}x${y_canvas}");
            $child_layer->Read('pattern:gray100');

            my $cperc  = int( 100 / ( $max_rep || 1 ) );
            $cperc    /= 2 if ( $cperc > 80 );
            note("Colorize -fill white -opacity $cperc%");
            my $plot = Image::Magick->new();
            $plot->Read( $self->plot_base() );
            $plot->Resize( $self->plot_size() ) if ( $self->plot_size() );
            $plot->Colorize( fill => 'white', 'opacity' => "$cperc%" );

            my @coords        = @{ Image::Heatmap::private::get( $self => 'coords' ) || [] };
            my $bucket_size   = scalar( @coords ) / $kids;
            my $bucket_offset = ( $child_num - 1 ) * $bucket_size;
            my @new_coords    = splice( @coords, $bucket_offset, $bucket_size ); 

            foreach my $coordinate ( @new_coords ) {

lib/Image/Heatmap.pm  view on Meta::CPAN

            Image::Heatmap::private::finish_work($self);
        }
    }

    foreach my $child ( @children ) {
        note("Blocking wait on pid:$child");
        my $pid_state = waitpid( $child, 0 );
        note("pid:$child - $pid_state :: $?");
    }

    my $layer = Image::Magick->new( size => "${x_canvas}x${y_canvas}");
    $layer->Read('pattern:gray100');

    foreach my $child_num ( 1 .. $kids ) {
        my $child_image = $self->tmp_dir() . sprintf( $kid_layer, $child_num );
        my $child_slice = Image::Magick->new();
        $child_slice->Read($child_image);

        note("Composite -image $child_image -compose Multiply -geometry +0+0");
        $layer->Composite( 
            'image'    => $child_slice,
            'compose'  => 'Multiply',
            'geometry' => '+0+0',
        );

        unlink($child_image);

lib/Image/Heatmap.pm  view on Meta::CPAN

    $heatmap->output('/tmp/heatmap.jpg');
    $heatmap->process();

    $heatmap->output('/tmp/heatmap.png');
    $heatmap->process();

=head1 SEE ALSO

=over

=item L<Image::Magick>

=item L<File::Find>

=back

=head1 TODO

=over

=item $VERSION > 1