File Coverage

blib/lib/GD/Graph/pie.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             #==========================================================================
2             # Copyright (c) 1995-1998 Martien Verbruggen
3             #--------------------------------------------------------------------------
4             #
5             # Name:
6             # GD::Graph::pie.pm
7             #
8             # $Id: pie.pm,v 1.21 2007/04/26 03:16:09 ben Exp $
9             #
10             #==========================================================================
11              
12             package GD::Graph::pie;
13              
14             ($GD::Graph::pie::VERSION) = '$Revision: 1.21 $' =~ /\s([\d.]+)/;
15              
16 1     1   3 use strict;
  1         2  
  1         54  
17              
18 1     1   4 use constant PI => 4 * atan2(1,1);
  1         1  
  1         64  
19              
20 1     1   215 use GD;
  0            
  0            
21             use GD::Graph;
22             use GD::Graph::utils qw(:all);
23             use GD::Graph::colour qw(:colours :lists);
24             use GD::Text::Align;
25             use Carp;
26              
27             @GD::Graph::pie::ISA = qw( GD::Graph );
28              
29             my $ANGLE_OFFSET = 90;
30              
31             my %Defaults = (
32            
33             # Set the height of the pie.
34             # Because of the dependency of this on runtime information, this
35             # is being set in GD::Graph::pie::initialise
36            
37             # pie_height => _round(0.1*${'width'}),
38             pie_height => undef,
39            
40             # Do you want a 3D pie?
41             '3d' => 1,
42            
43             # The angle at which to start the first data set
44             # 0 is at the front/bottom
45             start_angle => 0,
46              
47             # Angle below which a label on a pie slice is suppressed.
48             suppress_angle => 0, # CONTRIB idea ryan
49              
50             # and some public attributes without defaults
51             label => undef,
52              
53             # This misnamed attribute is used for pie marker colours
54             axislabelclr => 'black',
55             );
56              
57             # PRIVATE
58             sub _has_default {
59             my $self = shift;
60             my $attr = shift || return;
61             exists $Defaults{$attr} || $self->SUPER::_has_default($attr);
62             }
63              
64             sub initialise
65             {
66             my $self = shift;
67             $self->SUPER::initialise();
68             while (my($key, $val) = each %Defaults)
69             { $self->{$key} = $val }
70             $self->set( pie_height => _round(0.1 * $self->{height}) );
71             $self->set_value_font(gdTinyFont);
72             $self->set_label_font(gdSmallFont);
73             }
74              
75             # PUBLIC methods, documented in pod
76             sub plot
77             {
78             my $self = shift;
79             my $data = shift;
80              
81             $self->check_data($data) or return;
82             $self->init_graph() or return;
83             $self->setup_text() or return;
84             $self->setup_coords() or return;
85             $self->draw_text() or return;
86             $self->draw_pie() or return;
87             $self->draw_data() or return;
88              
89             return $self->{graph};
90             }
91              
92             sub set_label_font # (fontname)
93             {
94             my $self = shift;
95             $self->_set_font('gdta_label', @_) or return;
96             $self->{gdta_label}->set_align('bottom', 'center');
97             }
98              
99             sub set_value_font # (fontname)
100             {
101             my $self = shift;
102             $self->_set_font('gdta_value', @_) or return;
103             $self->{gdta_value}->set_align('center', 'center');
104             }
105              
106             # Inherit defaults() from GD::Graph
107              
108             # inherit checkdata from GD::Graph
109              
110             # Setup the coordinate system and colours, calculate the
111             # relative axis coordinates in respect to the canvas size.
112              
113             sub setup_coords()
114             {
115             my $self = shift;
116              
117             # Make sure we're not reserving space we don't need.
118             $self->{'3d'} = 0 if $self->{pie_height} <= 0;
119             $self->set(pie_height => 0) unless $self->{'3d'};
120              
121             my $tfh = $self->{title} ? $self->{gdta_title}->get('height') : 0;
122             my $lfh = $self->{label} ? $self->{gdta_label}->get('height') : 0;
123              
124             # Calculate the bounding box for the pie, and
125             # some width, height, and centre parameters (don't forget fenceposts!)
126             $self->{bottom} =
127             $self->{height} - $self->{pie_height} - $self->{b_margin} -
128             ( $lfh ? $lfh + $self->{text_space} : 0 ) - 1;
129             $self->{top} =
130             $self->{t_margin} + ( $tfh ? $tfh + $self->{text_space} : 0 );
131              
132             return $self->_set_error('Vertical size too small')
133             if $self->{bottom} - $self->{top} <= 0;
134              
135             $self->{left} = $self->{l_margin};
136             $self->{right} = $self->{width} - $self->{r_margin} - 1;
137              
138             # ensure that the center is a single pixel, not a half-pixel position
139             $self->{right}-- if ($self->{right} - $self->{left}) % 2;
140             $self->{bottom}-- if ($self->{bottom} - $self->{top}) % 2;
141              
142             return $self->_set_error('Horizontal size too small')
143             if $self->{right} - $self->{left} <= 0;
144              
145             $self->{w} = $self->{right} - $self->{left} + 1;
146             $self->{h} = $self->{bottom} - $self->{top} + 1;
147              
148             $self->{xc} = ($self->{right} + $self->{left})/2;
149             $self->{yc} = ($self->{bottom} + $self->{top})/2;
150              
151             return $self;
152             }
153              
154             # inherit open_graph from GD::Graph
155              
156             # Setup the parameters for the text elements
157             sub setup_text
158             {
159             my $self = shift;
160              
161             if ( $self->{title} )
162             {
163             #print "'$s->{title}' at ($s->{xc},$s->{t_margin})\n";
164             $self->{gdta_title}->set(colour => $self->{tci});
165             $self->{gdta_title}->set_text($self->{title});
166             }
167              
168             if ( $self->{label} )
169             {
170             $self->{gdta_label}->set(colour => $self->{lci});
171             $self->{gdta_label}->set_text($self->{label});
172             }
173              
174             $self->{gdta_value}->set(colour => $self->{alci});
175              
176             return $self;
177             }
178              
179             # Put the text on the canvas.
180             sub draw_text
181             {
182             my $self = shift;
183              
184             $self->{gdta_title}->draw($self->{xc}, $self->{t_margin})
185             if $self->{title};
186             $self->{gdta_label}->draw($self->{xc}, $self->{height} - $self->{b_margin})
187             if $self->{label};
188            
189             return $self;
190             }
191              
192             # draw the pie, without the data slices
193             sub draw_pie
194             {
195             my $self = shift;
196              
197             my $left = $self->{xc} - $self->{w}/2;
198              
199             $self->{graph}->arc(
200             $self->{xc}, $self->{yc},
201             $self->{w}, $self->{h},
202             0, 360, $self->{acci}
203             );
204              
205             $self->{graph}->arc(
206             $self->{xc}, $self->{yc} + $self->{pie_height},
207             $self->{w}, $self->{h},
208             0, 180, $self->{acci}
209             ) if ( $self->{'3d'} );
210              
211             $self->{graph}->line(
212             $left, $self->{yc},
213             $left, $self->{yc} + $self->{pie_height},
214             $self->{acci}
215             );
216              
217             $self->{graph}->line(
218             $left + $self->{w}, $self->{yc},
219             $left + $self->{w}, $self->{yc} + $self->{pie_height},
220             $self->{acci}
221             );
222              
223             return $self;
224             }
225              
226             # Draw the data slices
227              
228             sub draw_data
229             {
230             my $self = shift;
231              
232             my $total = 0;
233             my @values = $self->{_data}->y_values(1); # for now, only one pie..
234             for (@values)
235             {
236             $total += $_
237             }
238              
239             return $self->_set_error("Pie data total is <= 0")
240             unless $total > 0;
241              
242             my $ac = $self->{acci}; # Accent colour
243             my $pb = $self->{start_angle};
244              
245             for (my $i = 0; $i < @values; $i++)
246             {
247             next unless $values[$i];
248             # Set the data colour
249             my $dc = $self->set_clr_uniq($self->pick_data_clr($i + 1));
250              
251             # Set the angles of the pie slice
252             # Angle 0 faces down, positive angles are clockwise
253             # from there.
254             # ---
255             # / \
256             # | |
257             # \ | /
258             # ---
259             # 0
260             # $pa/$pb include the start_angle (so if start_angle
261             # is 90, there will be no pa/pb < 90.
262             my $pa = $pb;
263             $pb += my $slice_angle = 360 * $values[$i]/$total;
264              
265             # Calculate the end points of the lines at the boundaries of
266             # the pie slice
267             my ($xe, $ye) = cartesian(
268             $self->{w}/2, $pa,
269             $self->{xc}, $self->{yc}, $self->{h}/$self->{w}
270             );
271              
272             $self->{graph}->line($self->{xc}, $self->{yc}, $xe, $ye, $ac);
273              
274             # Draw the lines on the front of the pie
275             $self->{graph}->line($xe, $ye, $xe, $ye + $self->{pie_height}, $ac)
276             if in_front($pa) && $self->{'3d'};
277              
278             # Make an estimate of a point in the middle of the pie slice
279             # And fill it
280             ($xe, $ye) = cartesian(
281             3 * $self->{w}/8, ($pa+$pb)/2,
282             $self->{xc}, $self->{yc}, $self->{h}/$self->{w}
283             );
284              
285             $self->{graph}->fillToBorder($xe, $ye, $ac, $dc);
286              
287             # If it's 3d, colour the front ones as well
288             #
289             # if one slice is very large (>180 deg) then we will need to
290             # fill it twice. sbonds.
291             #
292             # Independently noted and fixed by Jeremy Wadsack, in a slightly
293             # different way.
294             if ($self->{'3d'})
295             {
296             foreach my $fill ($self->_get_pie_front_coords($pa, $pb))
297             {
298             my ($fx,$fy) = @$fill;
299             my $new_y = $fy + $self->{pie_height}/2;
300             # Edge case (literally): if lines have converged, back up
301             # looking for a gap to fill
302             while ( $new_y > $fy ) {
303             if ($self->{graph}->getPixel($fx,$new_y) != $ac) {
304             $self->{graph}->fillToBorder($fx, $new_y, $ac, $dc);
305             last;
306             }
307             } continue { $new_y-- }
308             }
309             }
310             }
311              
312             # CONTRIB Jeremy Wadsack
313             #
314             # Large text, sticking out over the pie edge, could cause 3D pies to
315             # fill improperly: Drawing the text for a given slice before the
316             # next slice was drawn and filled could make the slice boundary
317             # disappear, causing the fill colour to flow out. With this
318             # implementation, all the text is on top of the pie.
319              
320             $pb = $self->{start_angle};
321             for (my $i = 0; $i < @values; $i++)
322             {
323             next unless $values[$i];
324              
325             my $pa = $pb;
326             $pb += my $slice_angle = 360 * $values[$i]/$total;
327              
328             next if $slice_angle <= $self->{suppress_angle};
329              
330             my ($xe, $ye) =
331             cartesian(
332             3 * $self->{w}/8, ($pa+$pb)/2,
333             $self->{xc}, $self->{yc}, $self->{h}/$self->{w}
334             );
335              
336             $self->put_slice_label($xe, $ye, $self->{_data}->get_x($i));
337             }
338              
339             return $self;
340              
341             } #GD::Graph::pie::draw_data
342              
343             sub _get_pie_front_coords # (angle 1, angle 2)
344             {
345             my $self = shift;
346             my $pa = level_angle(shift);
347             my $pb = level_angle(shift);
348             my @fills = ();
349              
350             if (in_front($pa))
351             {
352             if (in_front($pb))
353             {
354             # both in front
355             # don't do anything
356             # Ah, but if this wraps all the way around the back
357             # then both pieces of the front need to be filled.
358             # sbonds.
359             if ($pa >= $pb )
360             {
361             # This takes care of the left bit on the front
362             # Since we know exactly where we are, and in which
363             # direction this works, we can just get the coordinates
364             # for $pa.
365             my ($x, $y) = cartesian(
366             $self->{w}/2, $pa,
367             $self->{xc}, $self->{yc}, $self->{h}/$self->{w}
368             );
369              
370             # and move one pixel to the left, but only if we don't
371             # fall out of the pie!.
372             push @fills, [$x - 1, $y]
373             if $x - 1 > $self->{xc} - $self->{w}/2;
374              
375             # Reset $pa to the right edge of the front arc, to do
376             # the right bit on the front.
377             $pa = level_angle(-$ANGLE_OFFSET);
378             }
379             }
380             else
381             {
382             # start in front, end in back
383             $pb = $ANGLE_OFFSET;
384             }
385             }
386             else
387             {
388             if (in_front($pb))
389             {
390             # start in back, end in front
391             $pa = $ANGLE_OFFSET - 180;
392             }
393             elsif ( # both in back, but wrapping around the front
394             # CONTRIB kedlubnowski, Dan Rosendorf
395             $pa >= $pb && ($pa < 0 || $pb > 0)
396             or $pa < 0 && $pb > 0
397             )
398             {
399             $pa=$ANGLE_OFFSET - 180;
400             $pb=$ANGLE_OFFSET;
401             }
402             else
403             {
404             return;
405             }
406             }
407              
408             my ($x, $y) = cartesian(
409             $self->{w}/2, ($pa + $pb)/2,
410             $self->{xc}, $self->{yc}, $self->{h}/$self->{w}
411             );
412              
413             push @fills, [$x, $y];
414              
415             return @fills;
416             }
417              
418             # return true if this angle is on the front of the pie
419             # XXX UGLY! We need to leave a slight room for error because of rounding
420             # problems
421             sub in_front
422             {
423             my $a = level_angle(shift);
424             return
425             $a > ($ANGLE_OFFSET - 180 + 0.00000001) &&
426             $a < $ANGLE_OFFSET - 0.000000001;
427             }
428              
429             # XXX Ugh! I need to fix this. See the GD::Text module for better ways
430             # of doing this.
431             # return a value for angle between -180 and 180
432             sub level_angle # (angle)
433             {
434             my $a = shift;
435             return level_angle($a-360) if ( $a > 180 );
436             return level_angle($a+360) if ( $a <= -180 );
437             return $a;
438             }
439              
440             # put the slice label on the pie
441             sub put_slice_label
442             {
443             my $self = shift;
444             my ($x, $y, $label) = @_;
445              
446             return unless defined $label;
447              
448             $self->{gdta_value}->set_text($label);
449             $self->{gdta_value}->draw($x, $y);
450             }
451              
452             # return x, y coordinates from input
453             # radius, angle, center x and y and a scaling factor (height/width)
454             #
455             # $ANGLE_OFFSET is used to define where 0 is meant to be
456             sub cartesian
457             {
458             my ($r, $phi, $xi, $yi, $cr) = @_;
459              
460             return map _round($_), (
461             $xi + $r * cos(PI * ($phi + $ANGLE_OFFSET)/180),
462             $yi + $cr * $r * sin(PI * ($phi + $ANGLE_OFFSET)/180)
463             )
464             }
465              
466             "Just another true value";