File Coverage

blib/lib/SVG/Sparkline/RangeArea.pm
Criterion Covered Total %
statement 64 67 95.5
branch 7 8 87.5
condition n/a
subroutine 9 10 90.0
pod 2 2 100.0
total 82 87 94.2


line stmt bran cond sub pod time code
1             package SVG::Sparkline::RangeArea;
2              
3 3     3   13 use warnings;
  3         4  
  3         111  
4 3     3   14 use strict;
  3         6  
  3         104  
5 3     3   13 use Carp;
  3         4  
  3         215  
6 3     3   17 use SVG;
  3         6  
  3         20  
7 3     3   3113 use SVG::Sparkline::Utils;
  3         5  
  3         71  
8              
9 3     3   111 use 5.008000;
  3         10  
  3         1526  
10             our $VERSION = 1.11;
11              
12             # aliases to make calling shorter.
13             *_f = *SVG::Sparkline::Utils::format_f;
14              
15             sub valid_param {
16 0     0 1 0 return scalar grep { $_[1] eq $_ } qw/xrange yrange/;
  0         0  
17             }
18              
19             sub make
20             {
21 21     21 1 22 my ($class, $args) = @_;
22             # validate parameters
23 21         44 SVG::Sparkline::Utils::validate_array_param( $args, 'values' );
24 81         165 croak "'values' must be an array of pairs.\n"
25 17 100       22 if grep { 'ARRAY' ne ref $_ || 2 != @{$_} } @{$args->{values}};
  85 100       144  
  17         26  
26 81         85 my $valdesc = SVG::Sparkline::Utils::summarize_xy_values(
27 16         15 [ (map { $_->[0] } @{$args->{values}}), (reverse map { $_->[1] } @{$args->{values}}) ]
  16         20  
  81         105  
  16         17  
28             );
29 16         19 $valdesc->{xrange} = $#{$args->{values}};
  16         22  
30 16         14 $valdesc->{xmax} = $#{$args->{values}};
  16         17  
31 16         14 my $off = $valdesc->{xrange};
32 16         19 foreach my $v (@{$valdesc->{vals}}[($off+1) .. $#{$valdesc->{vals}}])
  16         26  
  16         19  
33             {
34 81         74 $v->[0] = $off--;
35             }
36              
37 16         35 SVG::Sparkline::Utils::calculate_xscale( $args, $valdesc->{xrange} );
38 16         29 SVG::Sparkline::Utils::calculate_yscale_and_offset( $args, $valdesc->{yrange}, $valdesc->{offset} );
39 16         33 my $svg = SVG::Sparkline::Utils::make_svg( $args );
40              
41 16         47 my $points = SVG::Sparkline::Utils::xypairs_to_points_str(
42             $valdesc->{vals}, $args->{xscale}, $args->{yscale}
43             );
44 16         61 $svg->polygon( fill=>$args->{color}, points=>$points, stroke=>'none' );
45              
46 16 100       644 if( exists $args->{mark} )
47             {
48 5         12 _make_marks( $svg,
49             xscale=>$args->{xscale}, yscale=>$args->{yscale},
50             values=>$args->{values}, mark=>$args->{mark},
51             base=>$valdesc->{base}
52             );
53             }
54              
55 16         74 return $svg;
56             }
57              
58             sub _make_marks
59             {
60 5     5   10 my ($svg, %args) = @_;
61            
62 5         8 my @marks = @{$args{mark}};
  5         9  
63 5         8 while(@marks)
64             {
65 5         7 my ($index,$color) = splice( @marks, 0, 2 );
66 5         11 $index = SVG::Sparkline::Utils::range_mark_to_index( 'RangeArea', $index, $args{values} );
67 5         11 _make_mark( $svg, %args, index=>$index, color=>$color );
68             }
69 5         9 return;
70             }
71              
72             sub _make_mark
73             {
74 5     5   11 my ($svg, %args) = @_;
75 5         5 my $index = $args{index};
76 5         5 my ($lo, $hi) = @{$args{values}->[$index]};
  5         6  
77 5         12 my $y = _f( ($lo-$args{base}) * $args{yscale} );
78 5         11 my $yh = _f( ($hi-$args{base}) * $args{yscale} );
79 5         11 my $x = _f($index * $args{xscale});
80              
81 5 50       12 if(abs($hi-$lo) <= 0.01)
82             {
83 0         0 $svg->circle( cx=>$x, cy=>$y, r=>1, fill=>$args{color}, stroke=>'none' );
84             }
85             else
86             {
87 5         14 $svg->line( x1=>$x, y1=>$y, x2=>$x, y2=>$yh,
88             fill=>'none', stroke=>$args{color}, 'stroke-width'=>1
89             );
90             }
91 5         254 return;
92             }
93              
94             1;
95              
96             __END__