add_bar_data_series() and now adds the series as a "bar" series.
(unpackaged) tests for horizontal chart styling
label handling for horizontal charts
add _feature_enabled() method
More cool changes from Patrick Michaud:
- Area charts
+ https://rt.cpan.org/Ticket/Display.html?id=7
+
+ - Imager::Graph::Horizontal::add_column_data_series() renamed to
+ add_bar_data_series() and now adds the series as a "bar" series.
Other changes:
- - horizonal_gridlines is now a feature and can be enabled like other
+ - horizonal_gridlines (vertical charts) and vertical_gridlines
+ (horizontal charts) are now features and can be enabled like other
features (or disabled)
- hoisted the dashed-line drawing into Imager::Graph::_line() and
you can disable a feature with:
{ stylename => 0 }
- - for vertical charts, allow the outline of the graph area
- (graph_outline) to be disabled (with nograph_outline in features.)
+ - for vertical and horizontal charts, allow the outline of the graph
+ area (graph_outline) to be disabled (with nograph_outline in
+ features.) or styled (graph.outline)
- - for vertical charts, allow the fill of the graph area to be
- controlled separately from the base bg (graph.fill)
+ - for vertical and horizontal charts, allow the fill of the graph
+ area to be controlled separately from the base bg (graph.fill)
- tests
- make draw() idempotent for vertical charts
- - multiple calls to draw() no longer return the same image
+ - multiple calls to draw() no longer return the same image object
- labels supplied to draw() are now used for vertical and horizontal
charts
TODO:
- - changes from Vertical into Horizontal too:
-
- - gridlines control
-
- - chart area outline control
-
- - line style for gridlines
-
- - line style for chart area outline
-
- control of drawing markers for:
- area
- tests:
- - gridlines control for h
-
- - gridlines styling for h
-
- - graph area outline control for h
-
- - graph area outline style for h
-
- test idempotent for h
- document:
$self->_line(x1 => $xmin+1, y1 => $ymax, x2 => $xmax-1, y2 => $ymax, %work_opts);
}
$self->_line(x1 => $xmin, y1 => $ymin, x2 => $xmin, y2 => $ymax, %work_opts);
- return $self->_line(x1 => $xmin, y1 => $ymin, x2 => $xmin, y2 => $ymax, %work_opts);
+ return $self->_line(x1 => $xmax, y1 => $ymin, x2 => $xmax, y2 => $ymax, %work_opts);
}
}
+sub _feature_enabled {
+ my ($self, $name) = @_;
+
+ return $self->{_style}{features}{$name};
+}
+
1;
__END__
return;
}
-=item add_column_data_series(\@data, $series_name)
+=item add_bar_data_series(\@data, $series_name)
-Add a column data series to the graph.
+Add a bar data series to the graph.
=cut
-sub add_column_data_series {
+sub add_bar_data_series {
my $self = shift;
my $data_ref = shift;
my $series_name = shift;
- $self->_add_data_series('column', $data_ref, $series_name);
+ $self->_add_data_series('bar', $data_ref, $series_name);
return;
}
# Scale the graph box down to the widest graph that can cleanly hold the # of columns.
return unless $self->_get_data_range();
- $self->_remove_tics_from_chart_box(\@chart_box);
+ $self->_remove_tics_from_chart_box(\@chart_box, \%opts);
my $column_count = $self->_get_column_count();
my $width = $self->_get_number('width');
my $tic_distance = int(($graph_width -1) / ($tic_count - 1));
$graph_width = $tic_distance * ($tic_count - 1);
- my $bottom = $chart_box[1];
+ my $top = $chart_box[1];
my $left = $chart_box[0];
$self->{'_style'}{'graph_width'} = $graph_width;
$self->{'_style'}{'graph_height'} = $graph_height;
- my @graph_box = ($left, $bottom, $left + $graph_width, $bottom + $graph_height);
+ my @graph_box = ($left, $top, $left + $graph_width, $top + $graph_height);
+
$self->_set_graph_box(\@graph_box);
- $img->box(
- color => $self->_get_color('outline.line'),
- xmin => $left,
- xmax => $left+$graph_width,
- ymin => $bottom,
- ymax => $bottom+$graph_height,
- );
+ my @fill_box = @graph_box;
+
+ if ($self->_feature_enabled("graph_outline")) {
+ my @line = $self->_get_line("graph.outline")
+ or return;
+
+ $self->_box(
+ @line,
+ box => \@fill_box,
+ img => $img,
+ );
+ ++$fill_box[0];
+ ++$fill_box[1];
+ --$fill_box[2];
+ --$fill_box[3];
+ }
$img->box(
- color => $self->_get_color('bg'),
- xmin => $left + 1,
- xmax => $left+$graph_width - 1,
- ymin => $bottom + 1,
- ymax => $bottom+$graph_height-1 ,
- filled => 1,
- );
+ $self->_get_fill("graph.fill"),
+ box => \@fill_box,
+ );
my $min_value = $self->_get_min_value();
my $max_value = $self->_get_max_value();
color => $self->_get_color('negative_bg'),
xmin => $left+1,
xmax => $zero_position,
- ymin => $bottom+1,
- ymax => $bottom+$graph_height - 1,
+ ymin => $top+1,
+ ymax => $top+$graph_height - 1,
filled => 1,
);
$img->line(
x1 => $zero_position,
- y1 => $bottom,
+ y1 => $top,
x2 => $zero_position,
- y2 => $bottom + $graph_height,
+ y2 => $top + $graph_height,
color => $self->_get_color('outline.line'),
);
}
+ $self->_reset_series_counter();
+
if ($self->_get_data_series()->{'bar'}) {
$self->_draw_bars();
}
if ($self->_get_x_tics()) {
$self->_draw_x_tics();
}
- if ($self->_get_labels()) {
- $self->_draw_y_tics();
+ if ($self->_get_labels(\%opts)) {
+ $self->_draw_y_tics(\%opts);
}
return $self->_get_image();
Shows vertical gridlines at the y-tics.
+Feature: vertical_gridlines
+
=cut
sub show_vertical_gridlines {
$_[0]->{'custom_style'}{features}{'vertical_gridlines'} = 1;
}
+=item set_vertical_gridline_style(color => ..., style => ...)
+
+Set the color and style of the lines drawn for gridlines.
+
+Style equivalent: vgrid
+
+=cut
+
+sub set_vertical_gridline_style {
+ my ($self, %opts) = @_;
+
+ $self->{custom_style}{vgrid} ||= {};
+ @{$self->{custom_style}{vgrid}}{keys %opts} = values %opts;
+
+ return 1;
+}
+
=item use_automatic_axis()
Automatically scale the Y axis, based on L<Chart::Math::Axis>. If Chart::Math::Axis isn't installed, this sets an error and returns undef. Returns 1 if it is installed.
}
sub _remove_tics_from_chart_box {
- my $self = shift;
- my $chart_box = shift;
+ my ($self, $chart_box, $opts) = @_;
# XXX - bad default
- my $tic_width = $self->_get_y_tic_width() || 10;
+ my $tic_width = $self->_get_y_tic_width($opts) || 10;
my @y_tic_box = ($chart_box->[0], $chart_box->[1], $chart_box->[0] + $tic_width, $chart_box->[3]);
# XXX - bad default
}
sub _get_y_tic_width {
- my $self = shift;
+ my ($self, $opts) = @_;
- my $labels = $self->_get_labels();
+ my $labels = $self->_get_labels($opts);
if (!$labels) {
return;
}
sub _draw_y_tics {
- my $self = shift;
+ my ($self, $opts) = @_;
my $img = $self->_get_image();
my $graph_box = $self->_get_graph_box();
my $image_box = $self->_get_image_box();
- my $labels = $self->_get_labels();
+ my $labels = $self->_get_labels($opts);
my $tic_count = (scalar @$labels) - 1;
if ($show_gridlines && $x1 != $graph_box->[0] && $x1 != $graph_box->[2]) {
$self->_line(x1 => $x1, x2 => $x1,
- y1 => $y1, y2 => $y2,
+ y1 => $graph_box->[1], y2 => $graph_box->[3],
img => $img,
@grid_line);
}
sub _get_max_value { return $_[0]->{'max_value'} }
sub _get_image_box { return $_[0]->{'image_box'} }
sub _get_graph_box { return $_[0]->{'graph_box'} }
+sub _reset_series_counter { $_[0]->{series_counter} = 0 }
sub _get_series_counter { return $_[0]->{'series_counter'} }
+sub _style_defs {
+ my ($self) = @_;
+
+ my %work = %{$self->SUPER::_style_defs()};
+ push @{$work{features}}, qw/graph_outline graph_fill/;
+ $work{vgrid} =
+ {
+ color => "lookup(fg)",
+ style => "solid",
+ };
+
+ return \%work;
+}
+
sub _composite {
my ($self) = @_;
return ( $self->SUPER::_composite(), "graph", "vgrid" );
$self->_set_graph_box(\@graph_box);
my @fill_box = ( $left, $top, $left+$graph_width, $top+$graph_height );
- if ($self->{_style}{features}{graph_outline}) {
+ if ($self->_feature_enabled("graph_outline")) {
my @line = $self->_get_line("graph.outline")
or return;
$self->_box(
@line,
- xmin => $left,
- xmax => $left+$graph_width,
- ymin => $top,
- ymax => $top+$graph_height,
- img => $img,
+ box => \@fill_box,
+ img => $img,
);
++$fill_box[0];
++$fill_box[1];
$img->box(
$self->_get_fill('graph.fill'),
box => \@fill_box,
- );
+ );
my $min_value = $self->_get_min_value();
my $max_value = $self->_get_max_value();
use Imager qw(:handy);
-plan tests => 4;
+plan tests => 7;
my @warned;
local $SIG{__WARN__} =
my @data = ( 100, 180, 80, 20, 2, 1, 0.5 );
my @labels = qw(alpha beta gamma delta epsilon phi gi);
-my $column = Imager::Graph::Bar->new();
-$column->set_font($font);
-ok($column, "creating column chart object");
+{
+ my $bar = Imager::Graph::Bar->new();
+ $bar->set_font($font);
+ ok($bar, "creating bar chart object");
-$column->add_data_series(\@data);
-$column->set_labels(\@labels);
+ $bar->add_data_series(\@data);
+ $bar->set_labels(\@labels);
-my $img1 = $column->draw();
-ok($img1, "drawing column chart");
+ my $img1 = $bar->draw();
+ ok($img1, "drawing bar chart");
-$img1->write(file=>'testout/t14_bar.ppm') or die "Can't save img1: ".$img1->errstr."\n";
-cmpimg($img1, 'testimg/t14_bar.ppm', 1);
+ $img1->write(file=>'testout/t14_bar.ppm') or die "Can't save img1: ".$img1->errstr."\n";
+ cmpimg($img1, 'testimg/t14_bar.ppm', 1);
+}
+
+{ # alternative interfaces
+ my $bar = Imager::Graph::Horizontal->new();
+ $bar->set_font($font);
+ ok($bar, "creating bar chart object");
+
+ $bar->add_bar_data_series(\@data);
+ $bar->set_labels(\@labels);
+
+ my $img1 = $bar->draw();
+ ok($img1, "drawing bar chart");
+
+ $img1->write(file=>'testout/t14_bar2.ppm') or die "Can't save img1: ".$img1->errstr."\n";
+ cmpimg($img1, 'testimg/t14_bar.ppm', 1);
+}
unless (is(@warned, 0, "should be no warnings")) {
diag($_) for @warned;
--- /dev/null
+#!perl -w
+use strict;
+use Imager::Graph::Bar;
+use lib 't/lib';
+use Imager::Font::Test;
+use Test::More;
+use Imager::Test qw(is_image_similar is_image);
+
+-d 'testout'
+ or mkdir "testout", 0700
+ or die "Could not create output directory: $!";
+
+++$|;
+
+use Imager qw(:handy);
+
+#my $fontfile = 'ImUgly.ttf';
+#my $font = Imager::Font->new(file=>$fontfile, type => 'ft2', aa=>1)
+# or plan skip_all => "Cannot create font object: ",Imager->errstr,"\n";
+my $font = Imager::Font::Test->new();
+
+my @data1 =
+ (
+ 100, 180, 80, 20, 2, 1, 0.5 ,
+ );
+my @labels = qw(alpha beta gamma delta epsilon phi gi);
+
+plan tests => 22;
+
+# this may change output quality too
+print "# Imager version: $Imager::VERSION\n";
+print "# Font type: ",ref $font,"\n";
+
+{
+ my $colm = Imager::Graph::Bar->new;
+ ok($colm, "creating chart object");
+ $colm->set_x_tics(10);
+
+ $colm->add_data_series(\@data1, "Test Bar");
+
+ my $img1;
+ { # default outline of chart area
+ $img1 = $colm->draw
+ (
+ labels => \@labels,
+ font => $font,
+ title => "Test",
+ )
+ or print "# ", $colm->error, "\n";
+
+ ok($img1, "made the image");
+
+ ok($img1->write(file => "testout/x51col_def.ppm"),
+ "save to testout");
+
+ cmpimg($img1, "xtestimg/x51col_def.png");
+ }
+
+ { # no outline
+ my $img2 = $colm->draw
+ (
+ labels => \@labels,
+ font => $font,
+ title => "Test",
+ features => [ qw/nograph_outline/ ],
+ )
+ or print "# ", $colm->error, "\n";
+
+ isnt($img1, $img2, "make sure they're different images");
+
+ ok($img2, "made the image");
+
+ ok($img2->write(file => "testout/x51col_noout.ppm"),
+ "save to testout");
+
+ cmpimg($img2, "xtestimg/x51col_noout.png");
+ }
+
+ {
+ # check no state remembered from nograph_outline
+ my $img5 = $colm->draw
+ (
+ labels => \@labels,
+ font => $font,
+ title => "Test",
+ )
+ or print "# ", $colm->error, "\n";
+ ok($img5, "make with border again to check no state held");
+ is_image($img1, $img5, "check no state held");
+ }
+
+ { # styled outline
+ my $img6 = $colm->draw
+ (
+ labels => \@labels,
+ font => $font,
+ title => "Test styled outline",
+ graph =>
+ {
+ outline =>
+ {
+ color => "#fff",
+ style => "dashed",
+ },
+ },
+ );
+ ok($img6, "make chart with dashed outline of graph area");
+ ok($img6->write(file => "testout/x51col_dashout.ppm"),
+ "save it");
+ cmpimg($img6, "xtestimg/x51col_dashout.png");
+ }
+
+ { # no outline, styled fill
+ my $img7 = $colm->draw
+ (
+ labels => \@labels,
+ font => $font,
+ title => "Test styled outline",
+ features => "nograph_outline",
+ graph =>
+ {
+ fill => { solid => "ffffff80" },
+ },
+ )
+ or print "# ", $colm->error, "\n";
+ ok($img7, "made the image");
+ ok($img7->write(file => "testout/x51col_fill.ppm"),
+ "save it");
+ cmpimg($img7, "xtestimg/x51col_fill.png");
+ }
+
+ { # gridlines
+ my $img8 = $colm->draw
+ (
+ labels => \@labels,
+ font => $font,
+ title => "gridlines",
+ features => "vertical_gridlines",
+ vgrid => { style => "dashed", color => "#A0A0A0" },
+ )
+ or print "# ", $colm->error, "\n";
+ ok($img8, "made the gridline image");
+ ok($img8->write(file => "testout/x51col_grid.ppm"),
+ "save it");
+ cmpimg($img8, "xtestimg/x51col_grid.png");
+ }
+
+ { # gridlines (set by method)
+ my $colm2 = Imager::Graph::Bar->new;
+ $colm2->show_vertical_gridlines();
+ $colm2->set_vertical_gridline_style(style => "dashed", color => "#A0A0A0");
+ $colm2->set_labels(\@labels);
+ $colm2->set_title("gridlines");
+ $colm2->add_data_series(\@data1, "Test Bar");
+ $colm2->set_x_tics(10);
+ $colm2->set_font($font);
+
+ my $img9 = $colm2->draw
+ (
+ #labels => \@labels,
+ #font => $font,
+ #title => "gridlines",
+ #features => "vertical_gridlines",
+ #vgrid => { style => "dashed", color => "#A0A0A0" },
+ )
+ or print "# ", $colm2->error, "\n";
+ ok($img9, "made the gridline image (set by methods)");
+ ok($img9->write(file => "testout/x51col_gridm.ppm"),
+ "save it");
+ cmpimg($img9, "xtestimg/x51col_grid.png");
+ }
+}
+
+END {
+ unless ($ENV{IMAGER_GRAPH_KEEP_FILES}) {
+ unlink "testout/x51col_def.ppm";
+ unlink "testout/x51col_noout.ppm";
+ unlink "testout/x51col_dashout.ppm";
+ unlink "testout/x51col_fill.ppm";
+ unlink "testout/x51col_grid.ppm";
+ unlink "testout/x51col_gridm.ppm";
+ }
+}
+
+sub cmpimg {
+ my ($img, $file, $limit) = @_;
+
+ $limit ||= 10000;
+
+ 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});
+ is_image_similar($img, $cmpimg, $limit, "Comparison to $file ($diff)");
+ }
+}
projects / imager-graph.git / commitdiff
