File Coverage

blib/lib/Imager/Heatmap.pm

Criterion	Covered	Total	%
statement	92	92	100.0
branch	31	34	91.1
condition	8	9	88.8
subroutine	18	18	100.0
pod	9	9	100.0
total	158	162	97.5

package Imager::Heatmap;
use 5.008000;
use strict;
use warnings;
use utf8;
use XSLoader;
use Carp;
use Imager;
use List::Util qw/ max /;

our $VERSION = '0.03';
our %DEFAULTS = (
    xsigma      => 1,
    ysigma      => 1,
    correlation => 0.0,
);

XSLoader::load __PACKAGE__, $VERSION;

sub new {
    my ($class, %args) = @_;

    my $self = bless {}, $class;

    unless (exists $args{xsize} && exists $args{ysize}) {
        croak "You need to specify xsize and ysize";
    }
    $self->xsize(delete $args{xsize});
    $self->ysize(delete $args{ysize});

    $self->xsigma     ((exists $args{xsigma})      ? delete $args{xsigma}      : $DEFAULTS{xsigma});
    $self->ysigma     ((exists $args{ysigma})      ? delete $args{ysigma}      : $DEFAULTS{ysigma});
    $self->correlation((exists $args{correlation}) ? delete $args{correlation} : $DEFAULTS{correlation});

    if (keys %args) {
        croak "You did specify some unkown options: " . join ',', keys %args;
    }

    return $self;
}

sub xsize {
    my $self = shift;

    if (@_) {
        if ($_[0] < 0) { croak "xsize must be a positive number" }
        $self->{xsize} = $_[0];

        $self->_invalidate_matrix;
    }
    return $self->{xsize};
}

sub ysize {
    my $self = shift;

    if (@_) {
        if ($_[0] < 0) { croak "ysize must be a positive number" }
        $self->{ysize} = $_[0];

        $self->_invalidate_matrix;
    }
    return $self->{ysize};
}

sub xsigma {
    my $self = shift;

    if (@_) {
        if ($_[0] < 0.0) { croak "xsigma should be a positive number" }
        $self->{xsigma} = $_[0];
    }
    return $self->{xsigma}
}

sub ysigma {
    my $self = shift;

    if (@_) {
        if ($_[0] < 0.0) { croak "ysigma should be a positive number" }
        $self->{ysigma} = $_[0];
    }
    return $self->{ysigma}
}

sub correlation {
    my $self = shift;

    if (@_) {
        if ($_[0] < -1 || $_[0] > 1) {
            croak "correlation should be a number between -1 and 1";
        }
        $self->{correlation} = $_[0];
    }
    return $self->{correlation}
}

sub _invalidate_matrix {
    (shift)->{matrix} = undef;
}

sub matrix {
    my $self = shift;

    # Initialize array for size xsize * ysize and fill it by zero
    unless (defined $self->{matrix}) {
        $self->{matrix} = [ (0)x($self->xsize*$self->ysize) ];
    }

    return $self->{matrix};
}

sub insert_datas {
    my $self = shift;

    $self->{matrix} = xs_build_matrix(
        $self->matrix, \@_, # Insert datas
        $self->xsize, $self->ysize,
        $self->xsigma, $self->ysigma, $self->correlation,
    );
}

sub draw {
    my $self = shift;

    my $img = Imager->new(
        xsize    => $self->xsize,
        ysize    => $self->ysize,
        channels => 4,
    );

    my $matrix  = $self->matrix;

    my ($w, $h) = ($self->xsize, $self->ysize);
    my $max     = max(@{ $matrix });

    unless ($max) {
        carp "Nothing to be rendered";
        return $img;
    }

    my %color_cache;
    for (my $y = 0; $y < $h; $y++) {
        my @linedata = map {
            my $hue   = int((1 - $_/$max)*240);
            my $alpha = int(sqrt($_/$max)*255);

            $color_cache{"$hue $alpha"} ||= Imager::Color->new(
                hue        => $hue,
                saturation => 1.0,
                value      => 1.0,
                alpha      => $alpha,
            );
        } @$matrix[$y*$w..$y*$w+$w-1];

        $img->setscanline('y' => $y, pixels => \@linedata);
    }

    return $img;
}

1;
__END__