view release on metacpan or  search on metacpan

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

package ANSI::Heatmap;
# POD after __END__

use strict;
use warnings;

our $VERSION = 0.3;

use overload '""' => 'to_string';
use Carp;
use List::Util qw(min max);
use POSIX qw(floor modf);
use Class::Accessor::Fast;
our @ISA = qw(Class::Accessor::Fast);
our @_minmax_fields = map { ("min_$_", "max_$_") } qw(x y z);
our @_fields = ('half', 'interpolate', 'width', 'height', @_minmax_fields);
__PACKAGE__->mk_accessors(@_fields);

my $TOPBLOCK = "\N{U+2580}";
my %SWATCHES = (
    'blue-red'  => [0x10 .. 0x15, 0x39, 0x5d, 0x81, 0xa5, reverse(0xc4 .. 0xc9)],
    'grayscale' => [0xe8 .. 0xff],
);
my $DEFAULT_SWATCH = 'blue-red';

sub new {
    my $class = shift;
    my %args = (@_ == 1 && ref $_[0] && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
    my $self = bless { map => [], minmax => {} }, $class;
    $self->swatch($DEFAULT_SWATCH);
    $self->interpolate(0);
    $self->half(0);
    for my $field (@_fields, 'swatch') {
        $self->$field(delete $args{$field}) if exists $args{$field};
    }
    if (keys %args) {
        croak "Invalid constructor argument(s) " . join(', ', sort keys %args);
    }
    return $self;
}

sub swatch_names {
    my $self = shift;
    return (sort keys %SWATCHES);
}

sub set {
    my ($self, $x, $y, $z) = @_;
    $self->{map}[$y][$x] = $z;
    $self->_set_minmax(x => $x, y => $y, z => $z);
}

sub get {
    my ($self, $x, $y) = @_;
    return $self->{map}[$y][$x] || 0;
}

sub inc {
    my ($self, $x, $y) = @_;
    $self->set( $x, $y, $self->get($x, $y) + 1 );
}

sub swatch {
    my $self = shift;
    if (@_) {
        my $sw = shift;
        @_ == 0 or croak "swatch: excess arguments";
        if (ref $sw) {
            ref $sw eq 'ARRAY' or croak "swatch: invalid argument, should be string or arrayref";
            @$sw > 0 or croak "swatch: swatch is empty";
            $self->{swatch} = $sw;
        }
        else {
            defined $sw or croak "swatch: swatch name is undefined";
            exists $SWATCHES{$sw} or croak "swatch: swatch '$sw' does not exist";
            $self->{swatch} = $SWATCHES{$sw};
        }
    }
    return $self->{swatch};
}

sub to_string {
    my $self = shift;
    return $self->render($self->data);
}

# Convert heatmap hash to a 2D grid of intensities, normalised between 0 and 1,
# cropped to the min/max range supplied and scaled to the desired width/height.
sub data {