#!/usr/bin/env perl
#
# heatmap - converts a matrix of numeric values of some given size
# into a heat map. The first line must be a width and a height, and
# the subsequent lines integer values for each row and column of the
# given width, e.g. the input of
#
#   4 1
#   1 2 3 4
#
# indicates four columns and one row, followed by one line with the
# column values. Negative values are marked with black on the resulting
# image, positive values with a range of hues from blue to red.

use 5.14.0;
use warnings;
use Getopt::Std 'getopts';
use Imager;
use constant { NO_HEAT => -1, };
my %options = (
    # Use -F '' to turn off the numeric labels.
    F => '/usr/local/share/fonts/unifont/unifont.ttf',

    b => 32,           # Box (or cell) size.
    f => 'out.png',    # Output file.
    s => 1.0,          # Saturation (for HSV).

    #m => Use $min = 0 instead of that from the input.
    #q => Be quiet about various things.
);
getopts( 'F:b:f:m', \%options )
  or die "heatmap: unknown option supplied\n";
#use Data::Dumper; warn Dumper \%options;

my $font;
if ( length $options{F} ) {
    $font = Imager::Font->new( file => $options{F} )
      or die "heatmap: no such font '$options{F}'\n";
}

my ( $matrix_width, $matrix_height, @matrix );

my $header = readline;
if ( $header =~ m/^(?a)(\d+) (\d+)$/ ) {
    ( $matrix_width, $matrix_height ) = ( $1, $2 );
} else {
    die "heatmap: need a width and a height\n";
}

my $min = ~0;
my $max = 0;

########################################################################
#
# PARSE INPUT

# Read from standard in or all files listed on the command line.
while (readline) {
    chomp;
    my @nums;
  LOOP: {
        # Allow for an optional leading whitespace if someone is doing
        # printf("% 3d", ...) or such.
        redo LOOP if /\G^\s+/cg;
        # Each column must be followed by whitespace, or the end
        # of the line.
        if (/\G(?a)(-?\d+)(?:\s+|$)/cg) {
            my $n = $1;
            # Negative values are assumed to block the heat map (walls);
            # that is, they have NO_HEAT.
            if    ( $n < 0 )    { ; }
            elsif ( $n < $min ) { $min = $n }
            elsif ( $n > $max ) { $max = $n }
            push @nums, $n;
            redo LOOP;
        }
        last LOOP if /\G$/cg;
        # ... or it's invalid.
        my $where = pos();
        my $span  = (' ') x $where;
        die "heatmap: invalid line $ARGV:$. offset $where\n$_\n$span^\n";
    }
    my $ncol = @nums;
    die
      "heatmap: bad column count line $ARGV:$. got $ncol expect $matrix_width\n"
      if $ncol != $matrix_width;
    push @matrix, \@nums;
} continue {
    close ARGV if eof;
}

my $nrows = @matrix;
die "heatmap: bad row count: got $nrows expect $matrix_height\n"
  if $nrows != $matrix_height;

$min = 0 if exists $options{m};
warn "notice: range - $min .. $max\n" unless exists $options{q};
#use Data::Dumper; warn Dumper \@matrix;

########################################################################
#
# OUTPUT IMAGE

# Need +1 for the grid lines.
my ( $image_width, $image_height ) = (
    $options{b} * $matrix_width + 1,
    $options{b} * $matrix_height + 1
);

my $image = Imager->new(
    xsize => $image_width,
    ysize => $image_height,
) or die "heatmap: " . Imager->errstr;

# Hue - blue 240, red 360. TODO probably want flags for this, or an
# option for greyscale?
my $convert = slopeinator( $min, 240, $max, 360 );

# TODO the label font size may need a flag
my $font_size = int( $options{b} / 2 );
if ( $font_size < 9 ) {
    warn "notice: font size $font_size is too small for labels\n"
      unless exists $options{q};
    $font = '';
}

my @black_white = map { Imager::Color->new($_) } '#000000', '#FFFFFF';
my $grid_line_color = Imager::Color->new('#333333');

vgridline(0);
hgridline(0);
my $yy = 1;
for my $r ( 0 .. $matrix_height - 1 ) {
    my $xx = 1;
    for my $c ( 0 .. $matrix_width - 1 ) {
        my $box_color = cell_color( $matrix[$r][$c] );
        draw_box( $yy, $xx, $options{b}, $box_color );
        numeric_label( $yy, $xx, $box_color, $matrix[$r][$c] )
          if defined $font and $matrix[$r][$c] >= 0;
        $xx += $options{b};
        hgridline( $xx - 1 );
    }
    $yy += $options{b};
    vgridline( $yy - 1 );
}

$image->write( file => $options{f} );

sub cell_color {
    my ($amount) = @_;
    my $color;
    if ( $amount <= NO_HEAT ) {
        $color = $black_white[0];
    } else {
        my $hh = $convert->($amount);
        $color = Imager::Color->new(
            hue        => $hh,
            value      => 1,
            saturation => $options{s}
        );
    }
    return $color;
}

sub draw_box {
    my ( $yy, $xx, $size, $color ) = @_;
    $image->box(
        color  => $color,
        filled => 1,
        ymin   => $yy,
        xmin   => $xx,
        ymax   => $yy + $size,
        xmax   => $xx + $size,
    );
}

sub hgridline {
    $image->line(
        color => $grid_line_color,
        endp  => 0,
        x1    => $_[0],
        x2    => $_[0],
        y1    => 0,
        y2    => $image_height,
    );
}

sub vgridline {
    $image->line(
        color => $grid_line_color,
        endp  => 0,
        x1    => 0,
        x2    => $image_width,
        y1    => $_[0],
        y2    => $_[0],
    );
}

sub numeric_label {
    my ( $yy, $xx, $color, $amount ) = @_;
    $image->string(
        aa => 1,
        x  => $xx + 1,
        y  => $yy + $options{b} - 3,
        # Try to keep the label color visible regardless of what
        # it's put on.
        color => ( $color->hsv )[2] > 0.5 ? $black_white[0] : $black_white[1],
        font  => $font,
        size  => $font_size,
        string => $amount,
    );
}

# y=mx+b equation maker from the two given points.
sub slopeinator {
    my ( $x1, $y1, $x2, $y2 ) = @_;
    die "heatmap: not much of a range to show\n" if $x1 == $x2;
    my $mm = ( $y2 - $y1 ) / ( $x2 - $x1 );
    my $bb = $y2 - $mm * $x2;
    sub { $mm * $_[0] + $bb };
}