File Coverage

blib/lib/Chart/Clicker/Renderer/Pie.pm
Criterion Covered Total %
statement 24 24 100.0
branch n/a
condition n/a
subroutine 8 8 100.0
pod n/a
total 32 32 100.0


line stmt bran cond sub pod time code
1             package Chart::Clicker::Renderer::Pie;
2             $Chart::Clicker::Renderer::Pie::VERSION = '2.88';
3 1     1   46469 use Moose;
  1         497097  
  1         11  
4              
5             extends 'Chart::Clicker::Renderer';
6              
7             # ABSTRACT: Pie renderer
8              
9 1     1   9217 use Graphics::Color::RGB;
  1         907114  
  1         54  
10 1     1   989 use Geometry::Primitive::Arc;
  1         153425  
  1         48  
11 1     1   1078 use Geometry::Primitive::Circle;
  1         56915  
  1         49  
12 1     1   1168 use Graphics::Primitive::Brush;
  1         147500  
  1         46  
13 1     1   1213 use Graphics::Primitive::Paint::Gradient::Radial;
  1         317232  
  1         48  
14              
15 1     1   12 use Scalar::Util qw(refaddr);
  1         2  
  1         906  
16              
17              
18             has 'border_color' => (
19             is => 'rw',
20             isa => 'Graphics::Color::RGB',
21             default => sub { Graphics::Color::RGB->new },
22             );
23              
24              
25             has 'brush' => (
26             is => 'rw',
27             isa => 'Graphics::Primitive::Brush',
28             default => sub { Graphics::Primitive::Brush->new }
29             );
30              
31              
32             has 'gradient_color' => (
33             is => 'rw',
34             isa => 'Graphics::Color::RGB',
35             predicate => 'has_gradient_color'
36             );
37              
38              
39             has 'gradient_reverse' => (
40             is => 'rw',
41             isa => 'Bool',
42             default => 0,
43             );
44              
45              
46             has 'starting_angle' => (
47             is => 'rw',
48             isa => 'Int',
49             default => -90,
50             );
51              
52             my $TO_RAD = (4 * atan2(1, 1)) / 180;
53              
54             override('prepare', sub {
55             my $self = shift;
56              
57             super;
58              
59             my $clicker = $self->clicker;
60              
61             my $dses = $clicker->get_datasets_for_context($self->context);
62             foreach my $ds (@{ $dses }) {
63             foreach my $series (@{ $ds->series }) {
64             foreach my $val (@{ $series->values }) {
65             $self->{ACCUM}->{refaddr($series)} += $val;
66             $self->{TOTAL} += $val;
67             }
68             }
69             }
70              
71             });
72              
73             override('finalize', sub {
74             my $self = shift;
75              
76             my $clicker = $self->clicker;
77              
78             my $radius = $self->height;
79             if($self->width < $self->height) {
80             $radius = $self->width;
81             }
82              
83             $radius = $radius / 2;
84              
85             # Take into acount the line around the edge when working out the radius
86             $radius -= $self->brush->width;
87              
88             my $height = $self->height;
89             my $linewidth = 1;
90             my $midx = $self->width / 2;
91             my $midy = $height / 2;
92             my $pos = $self->starting_angle;
93              
94             my $dses = $clicker->get_datasets_for_context($self->context);
95             foreach my $ds (@{ $dses }) {
96             foreach my $series (@{ $ds->series }) {
97              
98             # TODO if undef...
99             my $ctx = $clicker->get_context($ds->context);
100             my $domain = $ctx->domain_axis;
101             my $range = $ctx->range_axis;
102              
103             my $avg = $self->{ACCUM}->{refaddr($series)} / $self->{TOTAL};
104             my $degs = ($avg * 360) + $pos;
105              
106             $self->move_to($midx, $midy);
107             $self->arc($radius, $degs * $TO_RAD, $pos * $TO_RAD);
108              
109             $self->close_path;
110              
111             my $color = $clicker->color_allocator->next;
112              
113             my $paint;
114             if($self->has_gradient_color) {
115             my $gc = $self->gradient_color;
116             my $start_radius = 0;
117             my $end_radius = $radius;
118              
119             if($self->gradient_reverse) {
120             $start_radius = $radius;
121             $end_radius = 0;
122             }
123              
124             $paint = Graphics::Primitive::Paint::Gradient::Radial->new(
125             start => Geometry::Primitive::Circle->new(
126             origin => [ $midx, $midy ],
127             radius => $start_radius
128             ),
129             end => Geometry::Primitive::Circle->new(
130             origin => [ $midx, $midy ],
131             radius => $end_radius
132             )
133             );
134             $paint->add_stop(0, $color);
135             $paint->add_stop(1, $color->clone(
136             red => $color->red + ($gc->red - $color->red) * $gc->alpha,
137             green => $color->green + ($gc->green - $color->green) * $gc->alpha,
138             blue => $color->blue + ($gc->blue - $color->blue) * $gc->alpha,
139             ));
140             } else {
141             $paint = Graphics::Primitive::Paint::Solid->new(
142             color => $color,
143             );
144             }
145              
146             my $fop = Graphics::Primitive::Operation::Fill->new(
147             preserve => 1,
148             paint => $paint
149             );
150             $self->do($fop);
151              
152             my $op = Graphics::Primitive::Operation::Stroke->new;
153             $op->brush($self->brush->clone);
154             $op->brush->color($self->border_color);
155             $self->do($op);
156              
157             $pos = $degs;
158             }
159             }
160              
161             return 1;
162             });
163              
164             __PACKAGE__->meta->make_immutable;
165              
166 1     1   8 no Moose;
  1         2  
  1         9  
167              
168             1;
169              
170             __END__
171              
172             =pod
173              
174             =head1 NAME
175              
176             Chart::Clicker::Renderer::Pie - Pie renderer
177              
178             =head1 VERSION
179              
180             version 2.88
181              
182             =head1 SYNOPSIS
183              
184             my $pier = Chart::Clicker::Renderer::Pie->new;
185             # Optionally set the stroke width
186             $pier->brush->width(2);
187              
188             =head1 DESCRIPTION
189              
190             Chart::Clicker::Renderer::Pie renders a dataset as slices of a pie. The keys
191             of like-named Series are totaled and keys are ignored. So for a dataset like:
192              
193             my $series = Chart::Clicker::Data::Series->new(
194             keys => [ 1, 2, 3 ],
195             values => [ 1, 2, 3],
196             );
197              
198             my $series2 = Chart::Clicker::Data::Series->new(
199             keys => [ 1, 2, 3],
200             values => [ 1, 1, 1 ],
201             );
202              
203             The keys are discarded and a pie chart will be drawn with $series' slice at
204             66% (1 + 2 + 3 = 6) and $series2's at 33% (1 + 1 + 1 = 3).
205              
206             =for HTML <p><img src="http://gphat.github.com/chart-clicker/static/images/examples/pie.png" width="300" height="250" alt="Pie Chart" /></p>
207              
208             =for HTML <p><img src="http://gphat.github.com/chart-clicker/static/images/examples/pie-gradient.png" width="300" height="250" alt="Pie Chart" /></p>
209              
210             =head1 ATTRIBUTES
211              
212             =head1 ATTRIBUTES
213              
214             =head2 border_color
215              
216             Set/Get the L<color|Graphics::Color::RGB> to use for the border.
217              
218             =head2 brush
219              
220             Set/Get a L<brush|Graphics::Primitive::Brush> to be used for the pie's border.
221              
222             =head2 gradient_color
223              
224             If supplied, specifies a L<color|Graphics::Color::RGB> to mix with each slice's color for use as a
225             radial gradient. The best results are usually gotten from mixing with a
226             white or black and manipulating the alpha, like so:
227              
228             $ren->gradient_color(
229             Graphics::Color::RGB->new(red => 1, green => 1, blue => 1, alpha => .3)
230             );
231              
232             The above will cause each generated color to fade toward a lighter version of
233             itself. Adjust the alpha to increase or decrease the effect.
234              
235             =head2 brush
236              
237             Set/Get whether or not the gradient is to be reversed.
238              
239             =head2 starting_angle
240              
241             Set/Get a starting angle for the gradient.
242              
243             =head1 AUTHOR
244              
245             Cory G Watson <gphat@cpan.org>
246              
247             =head1 COPYRIGHT AND LICENSE
248              
249             This software is copyright (c) 2014 by Cold Hard Code, LLC.
250              
251             This is free software; you can redistribute it and/or modify it under
252             the same terms as the Perl 5 programming language system itself.
253              
254             =cut