view release on metacpan or  search on metacpan

lib/Tempest.pm  view on Meta::CPAN

use constant LIB_MAGICK => 'Image::Magick';
use constant LIB_GMAGICK => 'Graphics::Magick';
use constant LIB_GD => 'GD';

=head1 PROPERTIES

=head2 Required Properties

=head3 C<input_file>

The generated heatmap will share the same dimensions as this image,
and - if indicated - will be overlaid onto this image with a given
opacity.

=cut

my %input_file;

=head3 C<output_file>

The generated heatmap will be written to this path, replacing any
existing file without warning.

=cut

my %output_file;

=head3 C<coordinates>

The contained x,y coordinates will mark the center of all plotted data
points in the heatmap.  Coordinates can - and in many cases are
expected to - be repeated.

=cut

my %coordinates;

=head2 Optional Properties

=head3 C<plot_file>

This image, expected to be greyscale, is used to plot data points for
each of the given coordinates.  Defaults to a bundled image, if none
is provided.

=cut

my %plot_file;

=head3 C<color_file>

This image, expected to be a true color vertical gradient, is used as a
color lookup table and is applied to the generated heatmap.  Defaults
to a bundled image, if none is provided.

=cut

my %color_file;

=head3 C<overlay>

If true, the heatmap is overlaid onto the input image with a given
opacity before being written to the filesystem.  Defaults to B<True>.

=cut

my %overlay;

=head3 C<opacity>

Indicates with what percentage of opaqueness to overlay the heatmap
onto the input image.  If 0, the heatmap will not be visible; if 100,
the input image will not be visible.  Defaults to b<50>.

=cut

my %opacity;

=head3 C<image_lib>

Indicates which supported image manipulation library should be used
for rendering operations.  Defaults to the first available from the
following:

=cut

my %image_lib;

my @_required = ('input_file', 'output_file', 'coordinates');
my @_optional = ('plot_file', 'color_file', 'overlay', 'opacity', 'image_lib');

=head1 METHODS

=head2 C<new>

Class constructor, accepts a hash of named arguments corresponding to
the class' own getter and setter methods.

    $heatmap = new Tempest(
      'input_file' => 'screenshot.png',
      'output_file' => 'heatmap.png',
      'coordinates' => [ [0,10], [2,14], [2,14] ],
    );

=cut

sub new {
    my $class = shift;
    
    croak('Bad parameter list, should be a hash') if @_ % 2;
    my %params = @_;
    
    # inside-out object model
    my $self = bless \(my $dummy), $class;
    
    # set defaults
    $plot_file{$self} = dirname(__FILE__) . '/Tempest/data/plot.png';
    $color_file{$self} = dirname(__FILE__) . '/Tempest/data/clut.png';
    $overlay{$self} = 1;
    $opacity{$self} = 50;
    $image_lib{$self} = $self->_calc_image_lib();
    
    # for all required parameters..
    for my $param_name (@_required) {
        # ..ensure they were provided
        if(!exists $params{$param_name}) {
            croak("Missing required parameter '$param_name'");
        }
        
        # ..and call each of their setters
        eval('$self->set_' . $param_name . '($params{$param_name})');
    }
    
    # for all optional parameters..
    for my $param_name (@_optional) {
        # ..if they were provided..
        if(exists $params{$param_name}) {
            # ..call their setters
            eval('$self->set_' . $param_name . '($params{$param_name})');
        }
    }
    
    return $self;
}

=head2 C<render>

Initiates processing of provided arguments, and writes a heatmap image
to the filesystem.  Returns B<True> on success.

    die('Rendering failed') if ! $heatmap->render();

=cut

sub render {
    my $self = shift;
    
    my $lib_name = ucfirst(lc($image_lib{$self}));
    $lib_name =~ s/\W//g;
    
    my $result = eval('require Tempest::'.$lib_name.'; return Tempest::'.$lib_name.'::render($self);');
    croak($@) if $@;
    return $result;
}

=head2 C<version>

Returns the version number of the current release.

    die('Outdated') if $heatmap->version() lt '2009.06.15';

=cut

sub version {
    return $VERSION;
}

=head2 C<api_version>

lib/Tempest.pm  view on Meta::CPAN

    if(ref($coordinates) ne 'ARRAY') {
        croak('Bad coordinates: not an array reference');
    }
    
    for my $pair (@{$coordinates}) {
        if(ref($pair) ne 'ARRAY' || scalar(@{$pair}) != 2) {
            croak('Bad coordinate pair: ' . join(',', @{$pair}));
        }
    }
    
    $coordinates{$self} = $coordinates;
    return $self;
}

sub get_coordinates {
    my $self = shift;
    return $coordinates{$self};
}


sub set_plot_file {
    my $self = shift;
    my $plot_file = shift;
    
    if(-r $plot_file) {
        $plot_file{$self} = $plot_file;
    }
    else {
        croak("Image '$plot_file' is not readable");
    }
    
    return $self;
}

sub get_plot_file {
    my $self = shift;
    return $plot_file{$self};
}


sub set_color_file {
    my $self = shift;
    my $color_file = shift;
    
    if(-r $color_file) {
        $color_file{$self} = $color_file;
    }
    else {
        croak("Image '$color_file' is not readable");
    }
    
    return $self;
}

sub get_color_file {
    my $self = shift;
    return $color_file{$self};
}


sub set_overlay {
    my $self = shift;
    my $overlay = shift;
    
    $overlay{$self} = $overlay ? 1 : 0;
    return $self;
}

sub get_overlay {
    my $self = shift;
    return $overlay{$self};
}


sub set_opacity {
    my $self = shift;
    my $opacity = shift;
    
    if($opacity >=0 && $opacity <= 100) {
        $opacity{$self} = $opacity;
    }
    else {
        croak("'$opacity' is not a valid percentage (integer from 0 to 100)");
    }
    
    return $self;
}

sub get_opacity {
    my $self = shift;
    return $opacity{$self};
}


sub set_image_lib {
    my $self = shift;
    my $image_lib = shift;
    
    if($self->has_image_lib($image_lib)) {
        $image_lib{$self} = $image_lib;
    }
    else {
        croak("Image library '$image_lib' could not be found");
    }
    
    return $self;
}

sub get_image_lib {
    my $self = shift;
    return $image_lib{$self};
}

=head2 C<has_image_lib>

Returns true value if the given image library is available.

    die('GD is unavailable') if ! $heatmap->has_image_lib(Tempest::LIB_GD);

=cut

sub has_image_lib {
    my $self = shift;
    my $image_lib = shift;
    
    # work as instance method or static method
    if(ref($self) ne 'Tempest') {
        $image_lib = $self;
        undef $self;
    }