File Coverage

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

linestmtbrancondsubtimecode
1package SVG::Sparkline::RangeBar;
2
3
3
3
3
3
8
3
84
use warnings;
4
3
3
3
3
8
1
42
use strict;
5
3
3
3
3
5
3
133
use Carp;
6
3
3
3
3
18
2
33
use SVG;
7
3
3
3
3
2586
3
24
use List::Util ();
8
3
3
3
3
463
4
52
use SVG::Sparkline::Utils;
9
10
3
3
3
3
111
7
1900
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
10
20
10
8
138
    return scalar grep { $_[1] eq $_ } qw/gap thick/;
18}
19
20sub make
21{
22
32
32
27
    my ($class, $args) = @_;
23    # validate parameters
24
32
368
    SVG::Sparkline::Utils::validate_array_param( $args, 'values' );
25
136
266
    croak "'values' must be an array of pairs.\n"
26
28
140
28
100
100
20
290
31
        if grep { 'ARRAY' ne ref $_ || 2 != @{$_} } @{$args->{values}};
27
136
442
    my $vals = SVG::Sparkline::Utils::summarize_values(
28
27
136
27
22
55
27
        [ map { @{$_} } @{$args->{values}} ]
29    );
30
31
27
47
    my $height = $args->{height} - 2*$args->{pady};
32
27
36
    my $yscale = -$height / $vals->{range};
33
27
319
    my $baseline = _f(-$yscale*$vals->{min});
34
35    # Figure out the width I want and define the viewBox
36
27
14
    my $dwidth;
37
27
100
78
    my $gap = $args->{gap} || 0;
38
27
100
41
    $args->{thick} ||= 3;
39
27
28
    my $space = $args->{thick}+$gap;
40
27
100
30
    if($args->{width})
41    {
42
1
1
        $dwidth = $args->{width} - $args->{padx}*2;
43
1
1
1
13
        $space = _f( $dwidth / @{$args->{values}} );
44
1
2
        $args->{thick} = $space - $gap;
45    }
46    else
47    {
48
26
26
16
32
        $dwidth = @{$args->{values}} * $space;
49
26
27
        $args->{width} = $dwidth + 2*$args->{padx};
50    }
51
27
34
    $args->{yoff} = -($baseline+$height+$args->{pady});
52
27
23
    $args->{xscale} = $space;
53
27
330
    my $svg = SVG::Sparkline::Utils::make_svg( $args );
54
55
27
298
    my $off = _f( $gap/2 );
56
27
21
    my $prev = 0;
57
27
307
    my $path = "M". _f(-$args->{thick}-$off).",0";
58
27
27
15
33
    foreach my $v (@{$args->{values}})
59    {
60        # Move from previous x,y to low value
61
136
1511
        $path .= 'm'. _f($args->{thick}+$gap) .','. _f($yscale*($v->[0]-$prev));
62
136
1497
        my $vert = _f( $yscale * ($v->[1]-$v->[0]) );
63
136
100
117
        if($vert)
64        {
65
130
1506
            $path .= "v${vert}h$args->{thick}v". _f(-$vert)."h-$args->{thick}";
66        }
67        else
68        {
69
6
8
            $path .= _zero_height_path( $args->{thick} );
70        }
71
136
127
        $prev = $v->[0];
72    }
73
27
30
    $path = _clean_path( $path );
74
27
224
    $svg->path( stroke=>'none', fill=>$args->{color}, d=>$path );
75
76
27
100
1123
    if( exists $args->{mark} )
77    {
78
9
16
        _make_marks( $svg,
79            thick=>$args->{thick}, off=>$off,
80            space=>$space, yscale=>$yscale,
81            values=>$args->{values}, mark=>$args->{mark}
82        );
83    }
84
27
305
    return $svg;
85}
86
87sub _zero_height_path
88{
89
7
7
6
    my ($thick) = @_;
90
7
10
    my $path = 'v-0.5';
91
7
4
    my $step = 1;
92
7
100
8
    $step = $thick/4 if $thick <= 2;
93
7
100
10
    $step = 2 if $thick >= 8;
94
7
9
    my $num_steps = int( $thick/$step ) - 1;
95
7
5
    my $leftover = $thick-($num_steps*$step);
96
7
8
    foreach my $i (1 .. $num_steps)
97    {
98
19
100
28
        $path .= "h${step}v" . ($i%2? 1 :-1);
99    }
100
7
100
18
    $path .= "h${leftover}v". ($thick%2?0.5: -0.5) . "h-$thick";
101
7
36
    return $path;
102}
103
104sub _make_marks
105{
106
9
9
18
    my ($svg, %args) = @_;
107
108
9
9
6
12
    my @marks = @{$args{mark}};
109
9
11
    while(@marks)
110    {
111
9
11
        my ($index,$color) = splice( @marks, 0, 2 );
112
9
103
        $index = SVG::Sparkline::Utils::range_mark_to_index( 'RangeBar', $index, $args{values} );
113
9
17
        _make_mark( $svg, %args, index=>$index, color=>$color );
114    }
115
9
12
    return;
116}
117
118sub _make_mark
119{
120
9
9
19
    my ($svg, %args) = @_;
121
9
6
    my $index = $args{index};
122
9
9
6
9
    my ($lo, $hi) = @{$args{values}->[$index]};
123
9
103
    my $y = _f( $hi * $args{yscale} );
124
9
107
    my $h = _f( ($hi-$lo) * $args{yscale});
125
9
100
10
    if($h)
126    {
127
8
90
        my $x = _f($index * $args{space} + $args{off});
128
8
67
        $svg->rect( x=>$x, y=>$y,
129            width=>$args{thick}, height=>abs($h),
130            stroke=>'none', fill=>$args{color}
131        );
132    }
133    else
134    {
135
1
11
        my $x = _f($index * $args{space} +$args{off});
136
1
2
        $svg->path(
137            d=>"M$x,$y". _zero_height_path( $args{thick} ),
138            stroke=>'none', fill=>$args{color}
139        );
140    }
141
9
412
    return;
142}
143
144sub _clean_path
145{
146
27
27
24
    my ($path) = @_;
147
27
27
85
372
    $path =~ s/^M([-.\d]+),([-.\d]+)m([-.\d]+),([-.\d]+)/'M'. _f($1+$3) .','. _f($2+$4)/e;
148
27
28
    $path =~ s/h0(?![.\d])//g;
149
27
36
    return $path;
150}
151
1521; # Magic true value required at end of module