File Coverage

blib/lib/SVG/Sparkline/RangeBar.pm
Criterion Covered Total %
statement 102 102 100.0
branch 20 20 100.0
condition 4 4 100.0
subroutine 13 13 100.0
pod 2 2 100.0
total 141 141 100.0


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