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   18 use warnings;
  3         6  
  3         127  
4 3     3   19 use strict;
  3         6  
  3         105  
5 3     3   16 use Carp;
  3         7  
  3         265  
6 3     3   17 use SVG;
  3         7  
  3         27  
7 3     3   4395 use SVG::Sparkline::Utils;
  3         8  
  3         106  
8              
9 3     3   263 use 5.008000;
  3         19  
  3         2628  
10             our $VERSION = 1.10;
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 32 my ($class, $args) = @_;
22             # validate parameters
23 21         80 SVG::Sparkline::Utils::validate_array_param( $args, 'values' );
24 81         294 croak "'values' must be an array of pairs.\n"
25 17 100       18 if grep { 'ARRAY' ne ref $_ || 2 != @{$_} } @{$args->{values}};
  85 100       209  
  17         46  
26 81         144 my $valdesc = SVG::Sparkline::Utils::summarize_xy_values(
27 16         20 [ (map { $_->[0] } @{$args->{values}}), (reverse map { $_->[1] } @{$args->{values}}) ]
  16         45  
  81         191  
  16         32  
28             );
29 16         194 $valdesc->{xrange} = $#{$args->{values}};
  16         39  
30 16         20 $valdesc->{xmax} = $#{$args->{values}};
  16         36  
31 16         25 my $off = $valdesc->{xrange};
32 16         31 foreach my $v (@{$valdesc->{vals}}[($off+1) .. $#{$valdesc->{vals}}])
  16         43  
  16         34  
33             {
34 81         121 $v->[0] = $off--;
35             }
36              
37 16         70 SVG::Sparkline::Utils::calculate_xscale( $args, $valdesc->{xrange} );
38 16         66 SVG::Sparkline::Utils::calculate_yscale_and_offset( $args, $valdesc->{yrange}, $valdesc->{offset} );
39 16         47 my $svg = SVG::Sparkline::Utils::make_svg( $args );
40              
41 16         68 my $points = SVG::Sparkline::Utils::xypairs_to_points_str(
42             $valdesc->{vals}, $args->{xscale}, $args->{yscale}
43             );
44 16         116 $svg->polygon( fill=>$args->{color}, points=>$points, stroke=>'none' );
45              
46 16 100       1089 if( exists $args->{mark} )
47             {
48 5         22 _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         122 return $svg;
56             }
57              
58             sub _make_marks
59             {
60 5     5   19 my ($svg, %args) = @_;
61            
62 5         8 my @marks = @{$args{mark}};
  5         16  
63 5         21 while(@marks)
64             {
65 5         15 my ($index,$color) = splice( @marks, 0, 2 );
66 5         17 $index = SVG::Sparkline::Utils::range_mark_to_index( 'RangeArea', $index, $args{values} );
67 5         22 _make_mark( $svg, %args, index=>$index, color=>$color );
68             }
69 5         13 return;
70             }
71              
72             sub _make_mark
73             {
74 5     5   64 my ($svg, %args) = @_;
75 5         10 my $index = $args{index};
76 5         8 my ($lo, $hi) = @{$args{values}->[$index]};
  5         14  
77 5         22 my $y = _f( ($lo-$args{base}) * $args{yscale} );
78 5         20 my $yh = _f( ($hi-$args{base}) * $args{yscale} );
79 5         16 my $x = _f($index * $args{xscale});
80              
81 5 50       17 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         25 $svg->line( x1=>$x, y1=>$y, x2=>$x, y2=>$yh,
88             fill=>'none', stroke=>$args{color}, 'stroke-width'=>1
89             );
90             }
91 5         484 return;
92             }
93              
94             1;
95              
96             __END__