File Coverage

blib/lib/GD/Graph/area.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             #==========================================================================
2             # Copyright (c) 1995-2000 Martien Verbruggen
3             #--------------------------------------------------------------------------
4             #
5             # Name:
6             # GD::Graph::area.pm
7             #
8             # $Id: area.pm,v 1.17 2007/04/26 03:16:09 ben Exp $
9             #
10             #==========================================================================
11              
12             package GD::Graph::area;
13            
14             ($GD::Graph::area::VERSION) = '$Revision: 1.17 $' =~ /\s([\d.]+)/;
15              
16 1     1   26 use strict;
  1         2  
  1         33  
17              
18 1     1   51 use GD::Graph::axestype;
  0            
  0            
19              
20             @GD::Graph::area::ISA = qw( GD::Graph::axestype );
21              
22             # PRIVATE
23             sub draw_data_set
24             {
25             my $self = shift; # object reference
26             my $ds = shift; # number of the data set
27              
28             my @values = $self->{_data}->y_values($ds) or
29             return $self->_set_error("Impossible illegal data set: $ds",
30             $self->{_data}->error);
31              
32             # Select a data colour
33             my $dsci = $self->set_clr($self->pick_data_clr($ds));
34             my $brci = $self->set_clr($self->pick_border_clr($ds));
35              
36             # Create a new polygon
37             my $poly = GD::Polygon->new();
38              
39             my (@top,@bottom);
40              
41             # Add the data points
42             for (my $i = 0; $i < @values; $i++)
43             {
44             my $value = $values[$i];
45             next unless defined $value;
46              
47             my $bottom = $self->_get_bottom($ds, $i);
48             $value = $self->{_data}->get_y_cumulative($ds, $i)
49             if $self->{cumulate};
50              
51             my ($x, $y) = $self->val_to_pixel($i + 1, $value, $ds);
52             push @top, [$x, $y];
53             # Need to keep track of this stuff for hotspots, and because
54             # it's the only reliable way of closing the polygon, without
55             # making odd assumptions.
56             push @bottom, [$x, $bottom];
57              
58             # Hotspot stuff
59             # XXX needs fixing. Not used at the moment.
60             next unless defined $self->{_hotspots}->[$ds]->[$i];
61             if ($i == 0)
62             {
63             $self->{_hotspots}->[$ds]->[$i] = ["poly",
64             $x, $y,
65             $x , $bottom,
66             $x - 1, $bottom,
67             $x - 1, $y,
68             $x, $y];
69             }
70             else
71             {
72             $self->{_hotspots}->[$ds]->[$i] = ["poly",
73             $poly->getPt($i),
74             @{$bottom[$i]},
75             @{$bottom[$i-1]},
76             $poly->getPt($i-1),
77             $poly->getPt($i)];
78             }
79             }
80              
81             foreach my $pair (@top, reverse @bottom)
82             {
83             $poly->addPt( @$pair );
84             }
85              
86             # Draw a filled and a line polygon
87             $self->{graph}->filledPolygon($poly, $dsci)
88             if defined $dsci;
89             $self->{graph}->polygon($poly, $brci)
90             if defined $brci;
91              
92             # Draw the accent lines
93             if (defined $brci &&
94             ($self->{right} - $self->{left})/@values > $self->{accent_treshold})
95             {
96             for my $i ( 0 .. $#top )
97             {
98             my ($x, $y) = @{$top[$i]};
99             my $bottom = $bottom[$i]->[1];
100             $self->{graph}->dashedLine($x, $y, $x, $bottom, $brci);
101             }
102             }
103              
104             return $ds
105             }
106              
107             "Just another true value";