view release on metacpan or  search on metacpan

lib/Imager/Graph/Pie.pm  view on Meta::CPAN

The C<data> parameter should be a reference to an array containing the
data the pie graph should present.

The C<labels> parameter is a reference to an array of labels,
corresponding to the values in C<data>.

=back

=head1 FEATURES

As described in L<Imager::Graph> you can enable extra features for
your graph.  The features you can use with pie graphs are:

=over

=item show_callouts_onAll_segments()

Feature: allcallouts.
X<allcallouts>X<features, allcallouts>

all labels are presented as callouts

=cut

sub show_callouts_onAll_segments {
    $_[0]->{'custom_style'}->{'features'}->{'allcallouts'} = 1;
}

=item show_only_label_percentages()

Feature: labelspconly
X<labelspconly>X<features, labelspconly>

only show the percentage, not the labels.

=cut

sub show_only_label_percentages {
    $_[0]->{'custom_style'}->{'features'}->{'labelspconly'} = 1;
}

=item show_label_percentages()

Feature: labelspc
X<labelspc>X<features, labelspc>

adds the percentage of the pie to each label.

=cut

sub show_label_percentages {
    $_[0]->{'custom_style'}->{'features'}->{'labelspc'} = 1;
}

=back

Inherited features:

=over

=item legend

adds a legend to your graph.  Requires the labels parameter

=item labels

labels each segment of the graph.  If the label doesn't fit inside the
segment it is presented as a callout.

=item outline

the pie segments are outlined.

=item dropshadow

the pie is given a drop shadow.

=back

=head1 PIE CHART STYLES

The following style values are specific to pie charts:

Controlling callouts, the C<callout> option:

=over

=item *

color - the color of the callout line and the callout text.

=item *

font, size - font and size of the callout text

=item *

outside - the distance the radial callout line goes outside the pie

=item *

leadlen - the length of the horizontal callout line from the end of
the radial line.

=item *

gap - the distance between the end of the horizontal callout line and
the label.

=item *

inside - the length of the radial callout line within the pie.

=back

The outline, line option controls the color of the pie segment
outlines, if enabled with the C<outline> feature.

Under C<pie>:

=over

=item *

maxsegment - any segment below this fraction of the total of the
segments will be put into the "others" segment.  Default: 0.01

=back

The top level C<otherlabel> setting controls the label for the
"others" segment, default "(others)".

=head1 EXAMPLES

Assuming:

  # from the Netcraft September 2001 web survey
  # http://www.netcraft.com/survey/
  my @data   = qw(17874757  8146372   1321544  811406 );
  my @labels = qw(Apache    Microsoft i_planet  Zeus   );

  my $pie = Imager::Graph::Pie->new;

First a simple graph, normal size, no labels:

  my $img = $pie->draw(data=>\@data)
    or die $pie->error;

label the segments:

  # error handling omitted for brevity from now on
  $img = $pie->draw(data=>\@data, labels=>\@labels, features=>'labels');

just percentages in the segments:

  $img = $pie->draw(data=>\@data, features=>'labelspconly');

add a legend as well:

  $img = $pie->draw(data=>\@data, labels=>\@labels,
                    features=>[ 'labelspconly', 'legend' ]);

and a title, but move the legend down, and add a dropshadow:

  $img = $pie->draw(data=>\@data, labels=>\@labels,
                    title=>'Netcraft Web Survey',
                    legend=>{ valign=>'bottom' },
                    features=>[ qw/labelspconly legend dropshadow/ ]);

something a bit prettier:

  $img = $pie->draw(data=>\@data, labels=>\@labels,
                    style=>'fount_lin', features=>'legend');

suitable for monochrome output:

  $img = $pie->draw(data=>\@data, labels=>\@labels,
                    style=>'mono', features=>'legend');

=cut

# this function is too long
sub draw {
  my ($self, %opts) = @_;

  my $data_series = $self->_get_data_series(\%opts);

  $self->_valid_input($data_series)
    or return;

  my @data = @{$data_series->[0]->{'data'}};

  my @labels = @{$self->_get_labels(\%opts) || []};

  $self->_style_setup(\%opts);

  my $style = $self->{_style};

  my $img = $self->_make_img()
    or return;

  my @chart_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
  if ($style->{title}{text}) {
    $self->_draw_title($img, \@chart_box)
      or return;
  }

  my $total = 0;
  for my $item (@data) {
    $total += $item;
  }

  # consolidate any segments that are too small to display
  $self->_consolidate_segments(\@data, \@labels, $total);

  if ($style->{features}{legend} && (scalar @labels)) {
    $self->_draw_legend($img, \@labels, \@chart_box)
      or return;
  }

  # the following code is fairly ugly
  # it attempts to work out a good layout for the components of the chart
  my @info;
  my $index = 0;
  my $pos = 0;
  my @ebox = (0, 0, 0, 0);
  defined(my $callout_outside = $self->_get_number('callout.outside'))
    or return;
  defined(my $callout_leadlen = $self->_get_number('callout.leadlen'))
    or return;
  defined(my $callout_gap = $self->_get_number('callout.gap'))
    or return;
  defined(my $label_vpad = $self->_get_number('label.vpad'))
    or return;
  defined(my $label_hpad = $self->_get_number('label.hpad'))
    or return;
  my $guessradius = 
    int($self->_small_extent(\@chart_box) * $style->{pie}{guessfactor} * 0.5);
  for my $data (@data) {
    my $item = { data=>$data, index=>$index };
    my $size = 2 * PI * $data / $total;
    $item->{begin} = $pos;
    $pos += $size;
    $item->{end} = $pos;
    if (scalar @labels) {
      $item->{text} = $labels[$index];
    }
    if ($style->{features}{labelspconly}) {
      $item->{text} = 
        $style->{label}{pconlyformat}->($data/$total * 100);
    }
    if ($item->{text}) {
      if ($style->{features}{labelspc}) {
        $item->{text} = 
          $style->{label}{pcformat}->($item->{text}, $data/$total * 100);
        $item->{label} = 1;
      }
      elsif ($style->{features}{labelspconly}) {
        $item->{text} = 
          $style->{label}{pconlyformat}->($data/$total * 100);
        $item->{label} = 1;
      }
      elsif ($style->{features}{labels}) {
        $item->{label} = 1;
      }
      $item->{callout} = 1 if $style->{features}{allcallouts};
      if (!$item->{callout}) {
        my @lbox = $self->_text_bbox($item->{text}, 'label')
          or return;
        $item->{lbox} = \@lbox;
        if ($item->{label}) {
          unless ($self->_fit_text(0, 0, 'label', $item->{text}, $guessradius,
                                   $item->{begin}, $item->{end})) {
            $item->{callout} = 1;
          }
        }
      }