view release on metacpan or  search on metacpan

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

  my @others;
  my $index = 0;
  for my $item (@$data) {
    if ($item / $total < $self->{_style}{pie}{maxsegment}) {
      push(@others, $index);
    }
    ++$index;
  }
  if (@others) {
    my $others = 0;
    for my $index (reverse @others) {
      $others += $data->[$index];
      splice(@$labels, $index, 1);
      splice(@$data, $index, 1);
    }
    push(@$labels, $self->{_style}{otherlabel}) if @$labels;
    push(@$data, $others);
  }
}

# used for debugging
sub _test_line {
  my ($x, $y, @l) = @_;

  my $res = $l[0]*$x + $l[1] * $y + $l[2];
  print "test ", (abs($res) < 0.000001) ? "success\n" : "failure $res\n";
}

=item _fit_text($cx, $cy, $name, $text, $radius, $begin, $end)

Attempts to fit text into a pie segment with its center at ($cx, $cy)
with the given radius, covering the angles $begin through $end.

Returns a list defining the bounding box of the text if it does fit.

=cut

sub _fit_text {
  my ($self, $cx, $cy, $name, $text, $radius, $begin, $end) = @_;

  #print "fit: $cx, $cy '$text' $radius $begin $end\n";
  my @tbox = $self->_text_bbox($text, $name)
    or return;
  my $tcx = floor(0.5+$cx + cos(($begin+$end)/2) * $radius *3/5);
  my $tcy = floor(0.5+$cy + sin(($begin+$end)/2) * $radius *3/5);
  my $topy = $tcy - $tbox[3]/2;
  my $boty = $topy + $tbox[3];
  my @lines;
  for my $y ($topy, $boty) {
    my %entry = ( 'y'=>$y );
    $entry{line} = [ line_from_points($tcx, $y, $tcx+1, $y) ];
    $entry{left} = -$radius;
    $entry{right} = $radius;
    for my $angle ($begin, $end) {
      my $ex = $cx + cos($angle)*$radius;
      my $ey = $cy + sin($angle)*$radius;
      my @line = line_from_points($cx, $cy, $ex, $ey);
      #_test_line($cx, $cy, @line);
      #_test_line($ex, $ey, @line);
      my $goodsign = $line[0] * $tcx + $line[1] * $tcy + $line[2];
      for my $pos (@entry{qw/left right/}) {
        my $sign = $line[0] * ($pos+$tcx) + $line[1] * $y + $line[2];
        if ($goodsign * $sign < 0) {
          if (my @p = intersect_lines(@line, @{$entry{line}})) {
            # die "$goodsign $sign ($pos, $tcx) no intersect (@line) (@{$entry{line}})"  ; # this would be wierd
            #_test_line(@p, @line);
            #_test_line(@p, @{$entry{line}});
            $pos = $p[0]-$tcx;
          }
          else {
            return;
          }
            
        }

        # circle
        my $dist2 = ($pos+$tcx-$cx) * ($pos+$tcx-$cx) 
          + ($y - $cy) * ($y - $cy);
        if ($dist2 > $radius * $radius) {
          my @points = 
            intersect_line_and_circle(@{$entry{line}}, $cx, $cy, $radius);
          while (@points) {
            my @p = splice(@points, 0, 2);
            if ($p[0] < $cx && $tcx+$pos < $p[0]) {
              $pos = $p[0]-$tcx;
            }
            elsif ($p[0] > $cx && $tcx+$pos > $p[0]) {
              $pos = $p[0]-$tcx;
            }
          }
        }
      }
    }
    push(@lines, \%entry);
  }
  my $left = $lines[0]{left} > $lines[1]{left} ? $lines[0]{left} : $lines[1]{left};
  my $right = $lines[0]{right} < $lines[1]{right} ? $lines[0]{right} : $lines[1]{right};
  return if $right - $left < $tbox[2];

  return ($tcx+$left, $topy, $tcx+$right, $boty);
}

sub _composite {
  ( 'pie', $_[0]->SUPER::_composite() );
}

sub _style_defs {
  my ($self) = @_;

  my %work = %{$self->SUPER::_style_defs()};
  $work{otherlabel} = "(others)";
  $work{pie} = 
    {
     guessfactor=>0.6,
     size=>0.8,
     maxsegment=> 0.01,
    };

  \%work;
}

1;
__END__

=back