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.89';
3 1     1   81283 use Moose;
  1         471814  
  1         6  
4              
5             extends 'Chart::Clicker::Renderer';
6              
7             # ABSTRACT: Pie renderer
8              
9 1     1   6198 use Graphics::Color::RGB;
  1         621476  
  1         48  
10 1     1   692 use Geometry::Primitive::Arc;
  1         95288  
  1         44  
11 1     1   710 use Geometry::Primitive::Circle;
  1         40052  
  1         45  
12 1     1   669 use Graphics::Primitive::Brush;
  1         101502  
  1         47  
13 1     1   750 use Graphics::Primitive::Paint::Gradient::Radial;
  1         230794  
  1         52  
14              
15 1     1   8 use Scalar::Util qw(refaddr);
  1         1  
  1         693  
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   6 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.89
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             =head2 border_color
213              
214             Set/Get the L<color|Graphics::Color::RGB> to use for the border.
215              
216             =head2 brush
217              
218             Set/Get a L<brush|Graphics::Primitive::Brush> to be used for the pie's border.
219              
220             =head2 gradient_color
221              
222             If supplied, specifies a L<color|Graphics::Color::RGB> to mix with each slice's color for use as a
223             radial gradient. The best results are usually gotten from mixing with a
224             white or black and manipulating the alpha, like so:
225              
226             $ren->gradient_color(
227             Graphics::Color::RGB->new(red => 1, green => 1, blue => 1, alpha => .3)
228             );
229              
230             The above will cause each generated color to fade toward a lighter version of
231             itself. Adjust the alpha to increase or decrease the effect.
232              
233             =head2 brush
234              
235             Set/Get whether or not the gradient is to be reversed.
236              
237             =head2 starting_angle
238              
239             Set/Get a starting angle for the gradient.
240              
241             =head1 AUTHOR
242              
243             Cory G Watson <gphat@cpan.org>
244              
245             =head1 COPYRIGHT AND LICENSE
246              
247             This software is copyright (c) 2016 by Cory G Watson.
248              
249             This is free software; you can redistribute it and/or modify it under
250             the same terms as the Perl 5 programming language system itself.
251              
252             =cut