use constant PI => 3.1415926535;
-# Imager doesn't have a arc boundary function, and the obvious code
-# either leaves gaps between the circle and the fill, or has some of the
-# fill outside the outline. These fudge factors produced good results
-# for the test images <sigh>
-use constant CIRCLE_FUDGE_X => 0.4;
-use constant CIRCLE_FUDGE_Y => 0.4;
-use constant CIRCLE_RADIUS_FUDGE => 0.2;
-
=item $graph->draw(...)
Draws a pie graph onto a new image and returns the image.
all labels are presented as callouts
-=item pieblur
-
-the segments are blurred, as a substitute for anti-aliased arcs
-
=item outline
the pie segments are outlined.
or return;
my $offy = $self->_get_number('dropshadow.offy');
for my $item (@info) {
- $img->arc(x=>$cx+$offx, 'y'=>$cy+$offy, r=>$radius+1,
+ $img->arc(x=>$cx+$offx, 'y'=>$cy+$offy, r=>$radius+1, aa => 1,
d1=>180/PI * $item->{begin}, d2=>180/PI * $item->{end},
@shadow_fill);
}
'dropshadow.filter')
if $style->{dropshadow}{filter};
}
+
my @fill_box = ( $cx-$radius, $cy-$radius, $cx+$radius, $cy+$radius );
for my $item (@info) {
my @fill = $self->_data_fill($item->{index}, \@fill_box)
or return;
- $img->arc(x=>$cx, 'y'=>$cy, r=>$radius,
+ $img->arc(x=>$cx, 'y'=>$cy, r=>$radius, aa => 1,
d1=>180/PI * $item->{begin}, d2=>180/PI * $item->{end},
@fill);
}
- if ($style->{features}{pieblur}) {
- $self->_pieblur($img, $cx, $cy, $radius);
- }
if ($style->{features}{outline}) {
my $outcolor = $self->_get_color('outline.line');
for my $item (@info) {
- my $px = int($cx + CIRCLE_FUDGE_X +
- ($radius+CIRCLE_RADIUS_FUDGE) * cos($item->{begin}));
- my $py = int($cy + CIRCLE_FUDGE_Y +
- ($radius+CIRCLE_RADIUS_FUDGE) * sin($item->{begin}));
+ my $px = int($cx + $radius * cos($item->{begin}));
+ my $py = int($cy + $radius * sin($item->{begin}));
$img->line(x1=>$cx, y1=>$cy, x2=>$px, y2=>$py, color=>$outcolor);
for (my $i = $item->{begin}; $i < $item->{end}; $i += PI/180) {
my $stroke_end = $i + PI/180;
$stroke_end = $item->{end} if $stroke_end > $item->{end};
- my $nx = int($cx + CIRCLE_FUDGE_X +
- ($radius+CIRCLE_RADIUS_FUDGE) * cos($stroke_end));
- my $ny = int($cy + CIRCLE_FUDGE_Y +
- ($radius+CIRCLE_RADIUS_FUDGE) * sin($stroke_end));
+ my $nx = int($cx + $radius * cos($stroke_end));
+ my $ny = int($cy + $radius * sin($stroke_end));
$img->line(x1=>$px, y1=>$py, x2=>$nx, y2=>$ny, color=>$outcolor,
antialias=>1);
($px, $py) = ($nx, $ny);
}
}
-=item _pieblur($img, $cx, $cy, $radius)
-
-Blurs the pie as a substitute for anti-aliased segments.
-
-=cut
-
-sub _pieblur {
- my ($self, $img, $cx, $cy, $radius) = @_;
-
- my $left = $cx - $radius - 2;
- $left > 1 or $left = 2;
- my $right = $cx + $radius + 2;
- my $top = $cy - $radius - 2;
- $top > 1 or $top = 2;
- my $bottom = $cy + $radius + 2;
-
- my $filter = $self->_get_thing("pie.blur")
- or return;
-
- # newer versions of Imager let you work on just part of an image
- if ($img->can('masked') && !$self->{_style}{features}{_debugblur}) {
- # the mask prevents the blur from leaking over the edges
- my $mask = Imager->new(xsize=>$right-$left, ysize=>$bottom-$top,
- channels=>1);
- $mask->arc(x=>$cx-$left, 'y'=>$cy-$top, r=>$radius);
- my $masked = $img->masked(mask=>$mask,
- left=>$left, top=>$top,
- right=>$right, bottom=>$bottom);
- $masked->filter(%{$self->{_style}{pie}{blur}});
- }
- else {
- # for older versions of Imager
- my $subset = $img->crop(left=>$left, top=>$top,
- right=>$right, bottom=>$bottom);
- $subset->filter(%{$self->{_style}{pie}{blur}});
- $img->paste(left=>$left, top=>$top, img=>$subset);
- }
-}
-
# used for debugging
sub _test_line {
my ($x, $y, @l) = @_;
#!perl -w
use strict;
use Imager::Graph::Pie;
+use Test::More;
-d 'testout'
or mkdir "testout", 0700
or die "Could not create output directory: $!";
++$|;
-print "1..11\n";
my $testnum = 1;
use Imager qw(:handy);
-# setting this to another font file will cause failed tests
-# but may produce nicer text
-my $fontfile; # = '/mnt/c/windows/fonts/arial.ttf';
+my $fontfile = 'ImUgly.ttf';
+my $font = Imager::Font->new(file=>$fontfile, aa=>1)
+ or plan skip_all => "Cannot create font object: ",Imager->errstr,"\n";
my @data = ( 100, 180, 80, 20, 2, 1, 0.5 );
my @labels = qw(alpha beta gamma delta epsilon phi gi);
+plan tests => 11;
+
my $pie = Imager::Graph::Pie->new;
ok($pie, "creating pie chart object");
# this may change output quality too
-#Imager::Font->priorities('ft2');
-$fontfile = 'ImUgly.ttf' unless $fontfile and -e $fontfile;
-my $font = Imager::Font->new(file=>$fontfile, aa=>1)
- or die "Cannot create font object: ",Imager->errstr,"\n";
print "# Imager version: $Imager::VERSION\n";
print "# Font type: ",ref $font,"\n";
title=>{ text=>'Imager::Graph::Pie', size=>32 },
features=>{ outline=>1, labels=>1, pieblur=>0, },
outline=>{ line => '404040' },
- )
- or print "# ",$pie->error,"\n";
+ );
-ok($img1, "drawing first pie chart");
+ok($img1, "drawing first pie chart")
+ or print "# ",$pie->error,"\n";
cmpimg($img1, "testimg/t10_pie1.png", 196880977);
-unlink('testout/t10_pie1.png');
-$img1->write(file=>'testout/t10_pie1.png')
+$img1->write(file=>'testout/t10_pie1.ppm')
or die "Cannot save pie1: ",$img1->errstr,"\n";
my $img2 = $pie->draw(data=>\@data,
legend=>1 },
legend=>{ border=>'000000', fill=>'FF8080', },
fills=>[ qw(404040 606060 808080 A0A0A0 C0C0C0 E0E0E0) ],
- )
- or print "# ",$pie->error,"\n";
+ );
-ok($img2, "drawing second pie chart");
+ok($img2, "drawing second pie chart")
+ or print "# ",$pie->error,"\n";
cmpimg($img2, "testimg/t10_pie2.png", 255956289);
-unlink('testout/t10_pie2.png');
-$img2->write(file=>'testout/t10_pie2.png')
+$img2->write(file=>'testout/t10_pie2.ppm')
or die "Cannot save pie2: ",$img2->errstr,"\n";
my ($im_version) = $Imager::VERSION =~ /(\d\.[\d_]+)/;
-if ($im_version > 0.38) {
+{
+ $im_version > 0.38
+ or skip("very old Imager", 6);
my $img3 = $pie->draw(data=>\@data, labels=>\@labels,
font=>$font, style=>'fount_lin',
features=>[ 'legend', 'labelspconly', ],
legend=>{ valign=>'center' });
- ok($img3, "third chart");
- $img3->write(file=>'testout/t10_lin_fount.png')
+ ok($img3, "third chart")
+ or print "# ",$pie->error,"\n";
+ $img3->write(file=>'testout/t10_lin_fount.ppm')
or die "Cannot save pie3: ",$img3->errstr,"\n";
cmpimg($img3, "testimg/t10_lin_fount.png", 180_000);
legend=>{ valign=>'bottom',
halign=>'left',
border=>'000080' });
- ok($img4, "fourth chart");
- $img4->write(file=>'testout/t10_rad_fount.png')
+ ok($img4, "fourth chart")
+ or print "# ",$pie->error,"\n";
+ $img4->write(file=>'testout/t10_rad_fount.ppm')
or die "Cannot save pie3: ",$img4->errstr,"\n";
cmpimg($img4, "testimg/t10_rad_fount.png", 120_000);
features=>[ 'allcallouts', 'labelspc' ],
legend=>{ valign=>'bottom',
halign=>'right' });
- ok($img5, "fifth chart");
- $img5->write(file=>'testout/t10_mono.png')
+ ok($img5, "fifth chart")
+ or print "# ",$pie->error,"\n";
+ $img5->write(file=>'testout/t10_mono.ppm')
or die "Cannot save pie3: ",$img5->errstr,"\n";
cmpimg($img5, "testimg/t10_mono.png", 550_000);
}
-else {
- skip("Imager not new enough", 6);
-}
-
-sub ok {
- my ($test, $comment) = @_;
-
- if ($test) {
- print "ok ",$testnum++," # $comment\n";
- }
- else {
- print "not ok ",$testnum++," # $comment\n";
- }
-}
-
-sub skip {
- my ($comment, $count) = @_;
-
- $count ||= 1;
- for (1..$count) {
- print "ok ",$testnum++," # skipped $comment\n";
- }
-}
sub cmpimg {
my ($img, $file, $limit) = @_;
$limit ||= 10000;
- if ($Imager::formats{png}) {
+ SKIP:
+ {
+ $Imager::formats{png}
+ or skip("No PNG support", 1);
+
my $cmpimg = Imager->new;
$cmpimg->read(file=>$file)
or return ok(0, "Cannot read $file: ".$cmpimg->errstr);
my $diff = Imager::i_img_diff($img->{IMG}, $cmpimg->{IMG});
- ok($diff < $limit, "Comparison to $file ($diff)");
- }
- else {
- skip("no png support");
+ cmp_ok($diff, '<', $limit, "Comparison to $file ($diff)");
}
}
projects / imager-graph.git / commitdiff
