File Coverage

File:blib/lib/SVG/Sparkline/Bar.pm
Coverage:100.0%

linestmtbrancondsubtimecode
1package SVG::Sparkline::Bar;
2
3
10
10
10
10
10010
13
258
use warnings;
4
10
10
10
10
27
9
155
use strict;
5
10
10
10
10
23
8
450
use Carp;
6
10
10
10
10
165
8327
148
use SVG;
7
10
10
10
10
11891
8
119
use List::Util ();
8
10
10
10
10
1163
14
192
use SVG::Sparkline::Utils;
9
10
10
10
10
10
295
24
7460
use 5.008000;
11our $VERSION = 0.35;
12
13# alias to make calling shorter.
14*_f = *SVG::Sparkline::Utils::format_f;
15
16sub valid_param {
17
5
10
5
5
72
    return scalar grep { $_[1] eq $_ } qw/gap thick/;
18}
19
20sub make
21{
22
41
41
45
    my ($class, $args) = @_;
23    # validate parameters
24
41
526
    SVG::Sparkline::Utils::validate_array_param( $args, 'values' );
25
37
433
    my $vals = SVG::Sparkline::Utils::summarize_values( $args->{values} );
26
27
37
52
    my $height = $args->{height} - 2*$args->{pady};
28
37
46
    my $yscale = -$height / $vals->{range};
29
37
467
    my $baseline = _f(-$yscale*$vals->{min});
30
31    # Figure out the width I want and define the viewBox
32
37
25
    my $dwidth;
33
37
100
137
    my $gap = $args->{gap} || 0;
34
37
100
54
    $args->{thick} ||= 3;
35
37
38
    my $space = $args->{thick}+$gap;
36
37
100
49
    if($args->{width})
37    {
38
1
1
        $dwidth = $args->{width} - $args->{padx}*2;
39
1
1
0
14
        $space = _f( $dwidth / @{$args->{values}} );
40
1
2
        $args->{thick} = $space - $gap;
41    }
42    else
43    {
44
36
36
20
44
        $dwidth = @{$args->{values}} * $space;
45
36
39
        $args->{width} = $dwidth + 2*$args->{padx};
46    }
47
37
55
    $args->{yoff} = -($baseline+$height+$args->{pady});
48
37
31
    $args->{xscale} = $space;
49
37
458
    my $svg = SVG::Sparkline::Utils::make_svg( $args );
50
51
37
425
    my $off = _f( $gap/2 );
52
37
33
    my $prev = 0;
53
37
23
    my @pieces;
54
37
37
23
46
    foreach my $v (@{$args->{values}})
55    {
56
287
3237
        my $curr = _f( $yscale*($v-$prev) );
57
287
100
383
        my $subpath = $curr ? "v${curr}h$args->{thick}" : "h$args->{thick}";
58
287
133
        $prev = $v;
59
287
100
100
373
        if($gap && $curr)
60        {
61
16
196
            $subpath .= 'v' . _f(-$curr);
62
16
12
            $prev = 0;
63        }
64
287
252
        push @pieces, $subpath;
65    }
66
37
100
307
    push @pieces, 'v' . _f( $yscale*(-$prev) ) if $prev;
67
37
100
44
    my $spacer = $gap ? "h$gap" : '';
68
37
70
    my $path = "M$off,0" . join( $spacer, @pieces ) . 'z';
69
37
40
    $path = _clean_path( $path );
70
37
343
    $svg->path( stroke=>'none', fill=>$args->{color}, d=>$path );
71
72
37
100
1572
    if( exists $args->{mark} )
73    {
74
20
33
        _make_marks( $svg,
75            thick=>$args->{thick}, off=>$off,
76            space=>$space, yscale=>$yscale,
77            values=>$args->{values}, mark=>$args->{mark}
78        );
79    }
80
37
456
    return $svg;
81}
82
83sub _make_marks
84{
85
20
20
46
    my ($svg, %args) = @_;
86
87
20
20
12
25
    my @marks = @{$args{mark}};
88
20
26
    while(@marks)
89    {
90
20
20
        my ($index,$color) = splice( @marks, 0, 2 );
91
20
20
        $index = _check_index( $index, $args{values} );
92
20
40
        _make_mark( $svg, %args, index=>$index, color=>$color );
93    }
94
20
29
    return;
95}
96
97sub _make_mark
98{
99
20
20
43
    my ($svg, %args) = @_;
100
20
15
    my $index = $args{index};
101
20
242
    my $h = _f($args{values}->[$index] * $args{yscale});
102
20
100
21
    if($h)
103    {
104
17
202
        my $x = _f($index * $args{space} + $args{off});
105
17
100
22
        my $y = $h > 0 ? 0 : $h;
106
17
144
        $svg->rect( x=>$x, y=>$y,
107            width=>$args{thick}, height=>abs( $h ),
108            stroke=>'none', fill=>$args{color}
109        );
110    }
111    else
112    {
113
3
38
        my $x = _f(($index+0.5) * $args{space} +$args{off});
114
3
28
        $svg->ellipse( cx=>$x, cy=>0, ry=>0.5, rx=>$args{thick}/2,
115            stroke=>'none', fill=>$args{color}
116        );
117    }
118
20
921
    return;
119}
120
121sub _check_index
122{
123
20
20
248
    return SVG::Sparkline::Utils::mark_to_index( 'Bar', @_ );
124}
125
126sub _clean_path
127{
128
41
41
67293
    my ($path) = @_;
129
41
8
166
10
    $path =~ s!((?:h[\d.]+){2,})!_consolidate_moves( $1 )!eg;
130
41
43
    $path =~ s/h0(?![.\d])//g;
131
41
75
    return $path;
132}
133
134sub _consolidate_moves
135{
136
8
8
15
    my ($moves) = @_;
137
8
28
    my @steps = split /h/, $moves;
138
8
8
    shift @steps; # discard empty initial string
139
8
137
    return 'h' . _f( List::Util::sum( @steps ) );
140}
141
1421; # Magic true value required at end of module