File Coverage

blib/lib/SVG/Sparkline/Utils.pm

Criterion	Covered	Total	%
statement	136	138	98.5
branch	58	64	90.6
condition	11	13	84.6
subroutine	16	16	100.0
pod	10	10	100.0
total	231	241	95.8

package SVG::Sparkline::Utils;

use warnings;
use strict;
use Carp;
use List::Util;
use SVG;

our $VERSION = 1.10;

sub format_f
{
    my $val = sprintf '%.02f', $_[0];
    $val =~ s/0$//;
    $val =~ s/\.0$//;
    $val = 0 if $val eq '-0';
    return $val;
}

sub calculate_xscale
{
    my ($args, $xrange) = @_;

    if( $args->{width} )
    {
        my $dwidth = $args->{width} - 2*$args->{padx};
        $args->{xscale} = ($dwidth-1) / $xrange;
    }
    else
    {
        $args->{xscale} ||= 2;
        my $dwidth = @{$args->{values}} * $args->{xscale} - 1;
        $args->{width} = $dwidth + 2*$args->{padx};
    }
    return;
}

sub calculate_yscale_and_offset
{
    my ($args, $yrange, $offset) = @_;

    # If the data values are all 0, default the range. Any value would be
    # usable. So, I just pick 1 arbitrarily.
    $yrange ||= 1;
    my $height = $args->{height} - 2*$args->{pady};
    $args->{yscale} = -$height / $yrange;
    my $baseline = format_f( -$args->{yscale} * $offset );

    $args->{yoff} = -($baseline+$height+$args->{pady});

    return;
}

sub xypairs_to_points_str
{
    my ($vals, $xscale, $yscale) = @_;
    return join( ' ',
        map { format_f($xscale * $_->[0]) .','. format_f($yscale * $_->[1]) }
        @{$vals}
    );
}

sub summarize_values
{
    my ($array) = @_;
    my $desc = {
        min => List::Util::min( @{$array} ),
        max => List::Util::max( @{$array} ),
    };

    $desc->{min} = 0 if $desc->{min} > 0;
    $desc->{max} = 0 if $desc->{max} < 0;

    $desc->{range} = $desc->{max}-$desc->{min};
    return $desc;
}

sub summarize_xy_values
{
    my ($array) = @_;
    return _summarize_xy_pairs( $array ) if 'ARRAY' eq ref $array->[0];
    my $desc = {
        ymin => List::Util::min( @{$array} ),
        ymax => List::Util::max( @{$array} ),
        xmin => 0,
        xmax => $#{$array},
        xrange => $#{$array},
    };
    $desc->{base}   = 0;
    $desc->{base}   = $desc->{ymin} if $desc->{ymin} > 0;
    $desc->{base}   = $desc->{ymax} if $desc->{ymax} < 0;
    $desc->{offset} = $desc->{ymin} - $desc->{base};

    $desc->{yrange} = $desc->{ymax}-$desc->{ymin};
    my $i = 0;
    $desc->{vals} = [map { [$i++,$_-$desc->{base}] } @{$array}];
    return $desc;
}

sub _summarize_xy_pairs
{
    my ($array) = @_;
    my $desc = {
        xmin => $array->[0]->[0],
        xmax => $array->[-1]->[0],
        ymin => $array->[0]->[1],
        ymax => $array->[0]->[1],
    };

    foreach my $p ( @{$array} )
    {
        die "Array element is not a pair.\n"
            unless 'ARRAY' eq ref $p && 2 == @{$p};
        $desc->{xmin} = $p->[0] if $p->[0] < $desc->{xmin};
        $desc->{xmax} = $p->[0] if $p->[0] > $desc->{xmax};
        $desc->{ymin} = $p->[1] if $p->[1] < $desc->{ymin};
        $desc->{ymax} = $p->[1] if $p->[1] > $desc->{ymax};
    }
    $desc->{base}   = 0;
    $desc->{base}   = $desc->{ymin} if $desc->{ymin} > 0;
    $desc->{base}   = $desc->{ymax} if $desc->{ymax} < 0;
    $desc->{offset} = $desc->{ymin} - $desc->{base};

    $desc->{xrange} = $desc->{xmax}-$desc->{xmin};
    $desc->{yrange} = $desc->{ymax}-$desc->{ymin};
    $desc->{vals} =
        [map { [$_->[0]-$desc->{xmin},$_->[1]-$desc->{base}] } @{$array}];
    return $desc;
}

sub make_svg
{
    my ($args) = @_;
    my $svg = SVG->new(
        -inline=>1, -nocredits=>1, -raiseerror=>1, -indent=>'', -elsep=>'',
        width=>$args->{width}, height=>$args->{height},
        viewBox=> join( ' ', @{$args}{qw/xoff yoff width height/} )
    );

    if( exists $args->{bgcolor} )
    {
        $svg->rect(
            x => $args->{xoff}-1, y => $args->{yoff}-1,
            width => $args->{width}+2, height => $args->{height}+2,
            stroke => 'none', fill => $args->{bgcolor}
        );
    }
    return $svg;
}

sub validate_array_param
{
    my ($args, $name) = @_;
    local $Carp::CarpLevel = 2;
    croak "Missing required '$name' parameter.\n" if !exists $args->{$name};
    croak "'$name' must be an array reference.\n" unless 'ARRAY' eq ref $args->{$name};
    croak "No values for '$name' specified.\n" unless @{$args->{$name}};
    return;
}

sub range_mark_to_index
{
    my ($type, $index, $values) = @_;
    return 0 if $index eq 'first';
    return $#{$values} if $index eq 'last';
    return $index if $index !~ /\D/ && $index < @{$values};
    if( 'high' eq $index )
    {
        my $high = $values->[0]->[1];
        my $ndx = 0;
        foreach my $i ( 1 .. $#{$values} )
        {
            ($high,$ndx) = ($values->[$i]->[1],$i) if $values->[$i]->[1] > $high;
        }
        return $ndx;
    }
    elsif( 'low' eq $index )
    {
        my $low = $values->[0]->[0];
        my $ndx = 0;
        foreach my $i ( 1 .. $#{$values} )
        {
            ($low,$ndx) = ($values->[$i]->[0],$i) if $values->[$i]->[0] < $low;
        }
        return $ndx;
    }

    croak "'$index' is not a valid mark for $type sparkline";
}

sub mark_to_index
{
    my ($type, $index, $values) = @_;
    return 0 if $index eq 'first';
    return $#{$values} if $index eq 'last';
    return $index if $index !~ /\D/ && $index < @{$values};
    if( 'high' eq $index )
    {
        my $high = $values->[0];
        my $ndx = 0;
        foreach my $i ( 1 .. $#{$values} )
        {
            ($high,$ndx) = ($values->[$i],$i) if $values->[$i] > $high;
        }
        return $ndx;
    }
    elsif( 'low' eq $index )
    {
        my $low = $values->[0];
        my $ndx = 0;
        foreach my $i ( 1 .. $#{$values} )
        {
            ($low,$ndx) = ($values->[$i],$i) if $values->[$i] < $low;
        }
        return $ndx;
    }

    croak "'$index' is not a valid mark for $type sparkline";
}


1;

__END__