File Coverage

blib/lib/SVG/Sparkline/Bar.pm

Criterion	Covered	Total	%
statement	92	92	100.0
branch	16	16	100.0
condition	9	9	100.0
subroutine	14	14	100.0
pod	2	2	100.0
total	133	133	100.0

package SVG::Sparkline::Bar;

use warnings;
use strict;
use Carp;
use SVG;
use List::Util ();
use SVG::Sparkline::Utils;

use 5.008000;
our $VERSION = 1.11;

# alias to make calling shorter.
*_f = *SVG::Sparkline::Utils::format_f;

sub valid_param {
    return scalar grep { $_[1] eq $_ } qw/gap thick/;
}

sub make
{
    my ($class, $args) = @_;
    # validate parameters
    SVG::Sparkline::Utils::validate_array_param( $args, 'values' );
    my $vals = SVG::Sparkline::Utils::summarize_values( $args->{values} );

    my $height = $args->{height} - 2*$args->{pady};
    # If we get all zeros for data, the range will be 0, and the division will
    # fail. Almost anything will be a reasonable range, so arbitrarily choose 1.
    my $yscale = -$height / ($vals->{range} || 1);
    my $baseline = _f(-$yscale*$vals->{min});

    # Figure out the width I want and define the viewBox
    my $dwidth;
    my $gap = $args->{gap} || 0;
    $args->{thick} ||= 3;
    my $space = $args->{thick}+$gap;
    if($args->{width})
    {
        $dwidth = $args->{width} - $args->{padx}*2;
        $space = _f( $dwidth / @{$args->{values}} );
        $args->{thick} = $space - $gap;
    }
    else
    {
        $dwidth = @{$args->{values}} * $space;
        $args->{width} = $dwidth + 2*$args->{padx};
    }
    $args->{yoff} = -($baseline+$height+$args->{pady});
    $args->{xscale} = $space;
    my $svg = SVG::Sparkline::Utils::make_svg( $args );

    my $off = _f( $gap/2 );
    my $prev = 0;
    my @pieces;
    foreach my $v (@{$args->{values}})
    {
        my $curr = _f( $yscale*($v-$prev) );
        my $subpath = $curr ? "v${curr}h$args->{thick}" : "h$args->{thick}";
        $prev = $v;
        if($gap && $curr)
        {
            $subpath .= 'v' . _f(-$curr);
            $prev = 0;
        }
        push @pieces, $subpath;
    }
    push @pieces, 'v' . _f( $yscale*(-$prev) ) if $prev;
    my $spacer = $gap ? "h$gap" : '';
    my $path = "M$off,0" . join( $spacer, @pieces ) . 'z';
    $path = _clean_path( $path );
    $svg->path( stroke=>'none', fill=>$args->{color}, d=>$path );

    if( exists $args->{mark} )
    {
        _make_marks( $svg,
            thick=>$args->{thick}, off=>$off,
            space=>$space, yscale=>$yscale,
            values=>$args->{values}, mark=>$args->{mark}
        );
    }
    return $svg;
}

sub _make_marks
{
    my ($svg, %args) = @_;

    my @marks = @{$args{mark}};
    while(@marks)
    {
        my ($index,$color) = splice( @marks, 0, 2 );
        $index = _check_index( $index, $args{values} );
        _make_mark( $svg, %args, index=>$index, color=>$color );
    }
    return;
}

sub _make_mark
{
    my ($svg, %args) = @_;
    my $index = $args{index};
    my $h = _f($args{values}->[$index] * $args{yscale});
    if($h)
    {
        my $x = _f($index * $args{space} + $args{off});
        my $y = $h > 0 ? 0 : $h;
        $svg->rect( x=>$x, y=>$y,
            width=>$args{thick}, height=>abs( $h ),
            stroke=>'none', fill=>$args{color}
        );
    }
    else
    {
        my $x = _f(($index+0.5) * $args{space} +$args{off});
        $svg->ellipse( cx=>$x, cy=>0, ry=>0.5, rx=>$args{thick}/2,
            stroke=>'none', fill=>$args{color}
        );
    }
    return;
}

sub _check_index
{
    return SVG::Sparkline::Utils::mark_to_index( 'Bar', @_ );
}

sub _clean_path
{
    my ($path) = @_;
    $path =~ s!((?:h[\d.]+){2,})!_consolidate_moves( $1 )!eg;
    $path =~ s/h0(?![.\d])//g;
    return $path;
}

sub _consolidate_moves
{
    my ($moves) = @_;
    my @steps = split /h/, $moves;
    shift @steps; # discard empty initial string
    return 'h' . _f( List::Util::sum( @steps ) );
}

1;

__END__