Revision history for Perl extension Imager::Graph.
+Imager-Graph 0.08 - unreleased
+=================
+
+Now depends on Imager 0.75.
+
+More cool changes from Patrick Michaud:
+
+ - Area charts
+
+Other changes:
+
+ - horizonal_gridlines is now a feature and can be enabled like other
+ features (or disabled)
+
+ - hoisted the dashed-line drawing into Imager::Graph::_line() and
+ added a _get_line() method to retrieve line style information.
+
+ - features enabled earlier in the style list can now be disabled with
+ a feature "no{stylename}" when features are supplied as an arrayref
+ or scalar. eg. "nograph_outline". If you supply features as a hashref
+ 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 charts, allow the fill of the graph area to be
+ controlled separately from the base bg (graph.fill)
+
+ - tests
+
+Bug fixes:
+
+ - generate y-axis tic-label widths baed on the labels actually used.
+
+ - make draw() idempotent for vertical charts
+
+ - multiple calls to draw() no longer return the same image
+
+ - 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
+
+ - line
+
+ - tic size/positioning
+
+ - gap between tic and labels
+
+ - 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:
+
+ - features: horizontal_gridlines, graph_outline, graph_fill
+
+ - graph outline and gridline styles
+
+ - document no{feature}
+
+
Imager-Graph 0.07 - 21 May 2009
=================
}
else {
# just set that single feature
- $work{features}{$src->{features}} = 1;
+ if ($src->{features} =~ /^no(.+)$/) {
+ delete $features{$1};
+ }
+ else {
+ $features{$src->{features}} = 1;
+ }
}
}
}
return '000000';
}
-=item _get_fill($index, $box)
+=item _get_fill($name, $box)
Retrieves fill parameters for a named fill.
return $self->_translate_fill($what, $box, @depth);
}
+=item _get_line($name)
+
+Return color (and possibly other) parameters for drawing a line with
+the _line() method.
+
+=cut
+
+sub _get_line {
+ my ($self, $name, @depth) = @_;
+
+ push (@depth, $name);
+ my $what;
+ if ($name =~ /^(\w+)\.(\w+)$/) {
+ $what = $self->{_style}{$1}{$2};
+ }
+ else {
+ $what = $self->{_style}{$name};
+ }
+
+ defined($what)
+ or return $self->_error("no line style $name found");
+
+ if (ref $what) {
+ if (eval { $what->isa("Imager::Color") }) {
+ return $what;
+ }
+ if (ref $what eq "HASH") {
+ # allow each kep to be looked up
+ my %work = %$what;
+
+ if ($work{color} =~ /^lookup\((.*)\)$/) {
+ $work{color} = $self->_get_color($1, @depth);
+ }
+ for my $key (keys %work) {
+ $key eq "color" and next;
+
+ if ($work{$key} =~ /^lookup\((.*)\)$/) {
+ $work{$key} = $self->_get_thing($1);
+ }
+ }
+
+ return %work;
+ }
+ return ( color => Imager::Color->new(@$what) );
+ }
+ else {
+ if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
+ @depth < MAX_DEPTH
+ or return $self->_error("too many levels of recursion in lookup (@depth)");
+ return $self->_get_line($1, @depth);
+ }
+ else {
+ # presumably a text color
+ my $color = Imager::Color->new($what)
+ or return $self->_error("Could not translate $what as a color: ".Imager->errstr);
+
+ return ( color => $color );
+ }
+ }
+}
+
=item _make_img()
Builds the image object for the graph and fills it with the background
$channels ||= 3;
- my $img = Imager->new(xsize=>$width, ysize=>$height, channels=>$channels);
+ my $img = Imager->new(xsize=>$width, ysize=>$height, channels=>$channels)
+ or return $self->_error("Error creating image: " . Imager->errstr);
$img->box($self->_get_fill('back', [ 0, 0, $width-1, $height-1]));
- $img;
+ $self->{_image} = $img;
+
+ return $img;
}
sub _get_image {
my $self = shift;
- if (!$self->{'_image'}) {
- $self->{'_image'} = $self->_make_img();
- }
return $self->{'_image'};
}
=cut
sub _composite {
- qw(title legend text label dropshadow outline callout);
+ qw(title legend text label dropshadow outline callout graph);
}
sub _filter_region {
$masked->filter(%$filter);
}
+=item _line(x1 => $x1, y1 => $y1, ..., style => $style)
+
+Wrapper for line drawing, implements styles Imager doesn't.
+
+Currently styles are limited to horizontal and vertical lines.
+
+=cut
+
+sub _line {
+ my ($self, %opts) = @_;
+
+ my $img = delete $opts{img}
+ or die "No img supplied to _line()";
+ my $style = delete $opts{style} || "solid";
+
+ if ($style eq "solid" || ($opts{x1} != $opts{x2} && $opts{y1} != $opts{y2})) {
+ return $img->line(%opts);
+ }
+ elsif ($style eq 'dashed' || $style eq 'dotted') {
+ my ($x1, $y1, $x2, $y2) = delete @opts{qw/x1 y1 x2 y2/};
+ # the line is vertical or horizontal, so swapping doesn't hurt
+ $x1 > $x2 and ($x1, $x2) = ($x2, $x1);
+ $y1 > $y2 and ($y1, $y2) = ($y2, $y1);
+ my ($stepx, $stepy) = ( 0, 0 );
+ my $step_size = $style eq "dashed" ? 8 : 2;
+ my ($counter, $count_end);
+ if ($x1 == $x2) {
+ $stepy = $step_size;
+ ($counter, $count_end) = ($y1, $y2);
+ }
+ else {
+ $stepx = $step_size;
+ ($counter, $count_end) = ($x1, $x2);
+ }
+ my ($x, $y) = ($x1, $y1);
+ while ($counter < $count_end) {
+ if ($style eq "dotted") {
+ $img->setpixel(x => $x, y => $y, color => $opts{color});
+ }
+ else {
+ my $xe = $stepx ? $x + $stepx / 2 - 1 : $x;
+ $xe > $x2 and $xe = $x2;
+ my $ye = $stepy ? $y + $stepy / 2 - 1 : $y;
+ $ye > $y2 and $ye = $y2;
+ $img->line(x1 => $x, y1 => $y, x2 => $xe, y2 => $ye, %opts);
+ }
+ $counter += $step_size;
+ $x += $stepx;
+ $y += $stepy;
+ }
+
+ return 1;
+ }
+ else {
+ $self->_error("Unknown line style $style");
+ return;
+ }
+}
+
+=item _box(xmin ..., style => $style)
+
+A wrapper for drawing styled box outlines.
+
+=cut
+
+sub _box {
+ my ($self, %opts) = @_;
+
+ my $style = delete $opts{style} || "solid";
+ my $img = delete $opts{img}
+ or die "No img supplied to _box";
+
+ if ($style eq "solid") {
+ return $img->box(%opts);
+ }
+ else {
+ my $box = delete $opts{box};
+ # replicate Imager's defaults
+ my %work_opts = ( xmin => 0, ymin => 0, xmax => $img->getwidth() - 1, ymax => $img->getheight() -1, %opts, style => $style, img => $img );
+ my ($xmin, $ymin, $xmax, $ymax) = delete @work_opts{qw/xmin ymin xmax ymax/};
+ if ($box) {
+ ($xmin, $ymin, $xmax, $ymax) = @$box;
+ }
+ $xmin > $xmax and ($xmin, $xmax) = ($xmax, $xmin);
+ $ymin > $ymax and ($ymin, $ymax) = ($ymax, $ymin);
+
+ if ($xmax - $xmin > 1) {
+ $self->_line(x1 => $xmin+1, y1 => $ymin, x2 => $xmax-1, y2 => $ymin, %work_opts);
+ $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);
+ }
+}
+
1;
__END__
\.rej$
\.bak$
^Imager-Graph
+
+# t/x tests aren't distributed
+^t/x
+^xtestimg/
my $style = $self->{_style};
+ $self->_make_img
+ or return;
+
my $img = $self->_get_image()
or return;
=cut
sub show_vertical_gridlines {
- $_[0]->{'custom_style'}->{'vertical_gridlines'} = 1;
+ $_[0]->{'custom_style'}{features}{'vertical_gridlines'} = 1;
}
=item use_automatic_axis()
my %text_info = $self->_text_style('legend')
or return;
- my $show_gridlines = $self->_get_number('vertical_gridlines');
+ my $show_gridlines = $self->{_style}{features}{'vertical_gridlines'};
+ my @grid_line = $self->_get_line("vgrid");
for my $count (0 .. $tic_count-1) {
my $x1 = $graph_box->[0] + ($tic_distance * $count);
text => $value
);
- if ($show_gridlines) {
- # XXX - line styles!
- for (my $i = $graph_box->[1]; $i < $graph_box->[3]; $i += 6) {
- my $y1 = $i;
- my $y2 = $i + 2;
- if ($y2 > $graph_box->[3]) { $y2 = $graph_box->[3]; }
- $img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => '000000');
- }
+ if ($show_gridlines && $x1 != $graph_box->[0] && $x1 != $graph_box->[2]) {
+ $self->_line(x1 => $x1, x2 => $x1,
+ y1 => $y1, y2 => $y2,
+ img => $img,
+ @grid_line);
}
}
}
sub _get_graph_box { return $_[0]->{'graph_box'} }
sub _get_series_counter { return $_[0]->{'series_counter'} }
+sub _composite {
+ my ($self) = @_;
+ return ( $self->SUPER::_composite(), "graph", "vgrid" );
+}
+
1;
my $style = $self->{_style};
+ $self->_make_img
+ or return;
+
my $img = $self->_get_image()
or 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 @fill_box = ( $left, $top, $left+$graph_width, $top+$graph_height );
if ($self->{_style}{features}{graph_outline}) {
- $img->box(
- color => $self->_get_color('graph.outline'),
- xmin => $left,
- xmax => $left+$graph_width,
- ymin => $top,
- ymax => $top+$graph_height,
- );
+ 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,
+ );
++$fill_box[0];
++$fill_box[1];
--$fill_box[2];
);
}
+ $self->_reset_series_counter();
+
if ($self->_get_data_series()->{'stacked_column'}) {
return unless $self->_draw_stacked_columns();
}
if ($self->_get_y_tics()) {
$self->_draw_y_tics();
}
- if ($self->_get_labels()) {
- $self->_draw_x_tics();
+ if ($self->_get_labels(\%opts)) {
+ $self->_draw_x_tics(\%opts);
}
return $self->_get_image();
=item show_horizontal_gridlines()
-Shows horizontal gridlines at the y-tics.
+Enables the C<horizontal_gridlines> feature, which shows horizontal
+gridlines at the y-tics.
+
+The style of the gridlines can be controlled with the
+set_horizontal_gridline_style() method (or by setting the hgrid
+style).
=cut
sub show_horizontal_gridlines {
- $_[0]->{'custom_style'}->{'horizontal_gridlines'} = 1;
+ $_[0]->{'custom_style'}{features}{'horizontal_gridlines'} = 1;
+}
+
+=item set_horizontal_gridline_style(style => $style, color => $color)
+
+Set the style and color of horizonal gridlines.
+
+See: L<Imager::Graph/"Line styles">
+
+=cut
+
+sub set_horizontal_gridline_style {
+ my ($self, %opts) = @_;
+
+ $self->{custom_style}{hgrid} ||= {};
+ @{$self->{custom_style}{hgrid}}{keys %opts} = values %opts;
+
+ return 1;
}
=item use_automatic_axis()
}
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 @y_tic_box = ($chart_box->[0], $chart_box->[1], $chart_box->[0] + $tic_width, $chart_box->[3]);
# XXX - bad default
- my $tic_height = $self->_get_x_tic_height() || 10;
+ my $tic_height = $self->_get_x_tic_height($opts) || 10;
my @x_tic_box = ($chart_box->[0], $chart_box->[3] - $tic_height, $chart_box->[2], $chart_box->[3]);
$self->_remove_box($chart_box, \@y_tic_box);
$self->_remove_box($chart_box, \@y_tic_tops);
# Make sure that the first and last label fit
- if (my $labels = $self->_get_labels()) {
+ if (my $labels = $self->_get_labels($opts)) {
if (my @box = $self->_text_bbox($labels->[0], 'legend')) {
my @remove_box = ($chart_box->[0],
$chart_box->[1],
}
}
-sub _get_y_tic_width{
+sub _get_y_tic_width {
my $self = shift;
my $min = $self->_get_min_value();
my $max = $self->_get_max_value();
}
sub _get_x_tic_height {
- my $self = shift;
+ my ($self, $opts) = @_;
- my $labels = $self->_get_labels();
+ my $labels = $self->_get_labels($opts);
if (!$labels) {
return;
or return;
my $line_style = $self->_get_color('outline.line');
- my $show_gridlines = $self->_get_number('horizontal_gridlines');
+ my $show_gridlines = $self->{_style}{features}{'horizontal_gridlines'};
+ my @grid_line = $self->_get_line("hgrid");
my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($tic_count - 1);
for my $count (0 .. $tic_count - 1) {
my $x1 = $graph_box->[0] - 5;
text => $value
);
- if ($show_gridlines) {
- # XXX - line styles!
- for (my $i = $graph_box->[0]; $i < $graph_box->[2]; $i += 6) {
- my $x1 = $i;
- my $x2 = $i + 2;
- if ($x2 > $graph_box->[2]) { $x2 = $graph_box->[2]; }
- $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => $line_style);
- }
+ if ($show_gridlines && $y1 != $graph_box->[1] && $y1 != $graph_box->[3]) {
+ $self->_line(x1 => $graph_box->[0], y1 => $y1,
+ x2 => $graph_box->[2], y2 => $y1,
+ img => $img,
+ @grid_line);
}
}
}
sub _draw_x_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;
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 {
opacity => 0.5,
};
push @{$work{features}}, qw/graph_outline graph_fill/;
+ $work{hgrid} =
+ {
+ color => "lookup(fg)",
+ style => "solid",
+ };
return \%work;
}
sub _composite {
my ($self) = @_;
- return ( $self->SUPER::_composite(), "graph" );
+ return ( $self->SUPER::_composite(), "graph", "hgrid" );
}
1;
);
my @labels = qw(alpha beta gamma delta epsilon phi gi);
-plan tests => 4;
-
-my $area = Imager::Graph::Area->new;
-ok($area, "creating area chart object");
-
-# this may change output quality too
-
-print "# Imager version: $Imager::VERSION\n";
-print "# Font type: ",ref $font,"\n";
-
-$area->add_data_series(\@data1, "Test Area");
-$area->add_data_series(\@data2, "Test Area 2");
+plan tests => 7;
+
+{
+ my $area = Imager::Graph::Area->new;
+ ok($area, "creating area chart object");
+
+ # this may change output quality too
+ print "# Imager version: $Imager::VERSION\n";
+ print "# Font type: ",ref $font,"\n";
+
+ $area->add_data_series(\@data1, "Test Area");
+ $area->add_data_series(\@data2, "Test Area 2");
+
+ my $img1 = $area->draw
+ (
+ #data => \@data,
+ labels => \@labels,
+ font => $font,
+ title => "Test",
+ features => { legend => 1 },
+ legend =>
+ {
+ valign => "bottom",
+ halign => "center",
+ orientation => "horizontal",
+ },
+ area =>
+ {
+ opacity => 0.8,
+ },
+ #outline => { line => '404040' },
+ )
+ or print "# ", $area->error, "\n";
+
+ ok($img1, "made the image");
+
+ ok($img1->write(file => "testout/t40area1.ppm"),
+ "save to testout");
+
+ cmpimg($img1, "testimg/t40area1.png");
+}
-my $img1 = $area->draw
- (
- #data => \@data,
- labels => \@labels,
- font => $font,
- title => "Test",
- features => { legend => 1 },
- legend =>
- {
- valign => "bottom",
- halign => "center",
- orientation => "horizontal",
- },
- area =>
- {
- opacity => 0.8,
- },
- #outline => { line => '404040' },
- )
- or print "# ", $area->error, "\n";
-
-ok($img1, "made the image");
-
-ok($img1->write(file => "testout/t40area1.ppm"),
- "save to testout");
-
-cmpimg($img1, "testimg/t40area1.png");
+{
+ my $area = Imager::Graph::Area->new;
+ ok($area, "made area chart object");
+ $area->add_data_series(\@data1, "Test area");
+ $area->show_horizontal_gridlines();
+ $area->use_automatic_axis();
+ my $img2 = $area->draw
+ (
+ features => [ "horizontal_gridlines" ],
+ labels => \@labels,
+ font => $font,
+ hgrid => { style => "dashed", color => "#888" },
+ graph =>
+ {
+ outline => { color => "#F00", style => "dotted" },
+ },
+ );
+ ok($img2, "made second area chart image");
+ ok($img2->write(file => "testout/t40area2.ppm"),
+ "save to file");
+}
END {
unless ($ENV{IMAGER_GRAPH_KEEP_FILES}) {
--- /dev/null
+#!perl -w
+use strict;
+use Imager::Graph::Line;
+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 => 29;
+
+# this may change output quality too
+print "# Imager version: $Imager::VERSION\n";
+print "# Font type: ",ref $font,"\n";
+
+{
+ my $vert = Imager::Graph::Vertical->new;
+ ok($vert, "creating chart object");
+ $vert->set_y_tics(10);
+
+ $vert->add_line_data_series(\@data1, "Test Line");
+
+ my $img1;
+ { # default outline of chart area
+ $img1 = $vert->draw
+ (
+ labels => \@labels,
+ font => $font,
+ title => "Test",
+ )
+ or print "# ", $vert->error, "\n";
+
+ ok($img1, "made the image");
+
+ ok($img1->write(file => "testout/x50line_def.ppm"),
+ "save to testout");
+
+ cmpimg($img1, "xtestimg/x50line_def.png");
+ }
+
+ { # no outline
+ my $img2 = $vert->draw
+ (
+ labels => \@labels,
+ font => $font,
+ title => "Test",
+ features => [ qw/nograph_outline/ ],
+ )
+ or print "# ", $vert->error, "\n";
+
+ isnt($img1, $img2, "make sure they're different images");
+
+ ok($img2, "made the image");
+
+ ok($img2->write(file => "testout/x50line_noout.ppm"),
+ "save to testout");
+
+ cmpimg($img2, "xtestimg/x50line_noout.png");
+
+ my $img3 = $vert->draw
+ (
+ labels => \@labels,
+ font => $font,
+ title => "Test",
+ features => "nograph_outline",
+ )
+ or print "# ", $vert->error, "\n";
+ ok($img3, "made with scalar features");
+ is_image($img3, $img2, "check that both feature mechanisms act the same");
+
+ my $img4 = $vert->draw
+ (
+ labels => \@labels,
+ font => $font,
+ title => "Test",
+ features => { "graph_outline" => 0 },
+ )
+ or print "# ", $vert->error, "\n";
+ ok($img4, "made with hashref features");
+ is_image($img4, $img2, "check that all feature mechanisms act the same");
+ }
+
+ {
+ # check no state remembered from nograph_outline
+ my $img5 = $vert->draw
+ (
+ labels => \@labels,
+ font => $font,
+ title => "Test",
+ )
+ or print "# ", $vert->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 = $vert->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/x50line_dashout.ppm"),
+ "save it");
+ cmpimg($img6, "xtestimg/x50line_dashout.png");
+ }
+
+ { # no outline, styled fill
+ my $img7 = $vert->draw
+ (
+ labels => \@labels,
+ font => $font,
+ title => "Test styled outline",
+ features => "nograph_outline",
+ graph =>
+ {
+ fill => { solid => "ffffffC0" },
+ },
+ )
+ or print "# ", $vert->error, "\n";
+ ok($img7, "made the image");
+ ok($img7->write(file => "testout/x50line_fill.ppm"),
+ "save it");
+ cmpimg($img7, "xtestimg/x50line_fill.png");
+ }
+
+ { # gridlines
+ my $img8 = $vert->draw
+ (
+ labels => \@labels,
+ font => $font,
+ title => "gridlines",
+ features => "horizontal_gridlines",
+ hgrid => { style => "dashed", color => "#A0A0A0" },
+ )
+ or print "# ", $vert->error, "\n";
+ ok($img8, "made the gridline image");
+ ok($img8->write(file => "testout/x50line_grid.ppm"),
+ "save it");
+ cmpimg($img8, "xtestimg/x50line_grid.png");
+
+ # default horizontal gridlines
+ my $imgb = $vert->draw
+ (
+ labels => \@labels,
+ font => $font,
+ title => "gridlines",
+ features => "horizontal_gridlines",
+ )
+ or print "# ", $vert->error, "\n";
+ ok($imgb, "made the gridline image");
+ ok($imgb->write(file => "testout/x50line_griddef.ppm"),
+ "save it");
+ cmpimg($imgb, "xtestimg/x50line_griddef.png");
+
+ }
+
+ { # gridlines (set by method)
+ my $vert2 = Imager::Graph::Vertical->new;
+ $vert2->show_horizontal_gridlines();
+ $vert2->set_horizontal_gridline_style(style => "dashed", color => "#A0A0A0");
+ $vert2->set_labels(\@labels);
+ $vert2->set_title("gridlines");
+ $vert2->add_line_data_series(\@data1, "Test Line");
+ $vert2->set_y_tics(10);
+ $vert2->set_font($font);
+
+ my $img9 = $vert2->draw
+ (
+ #labels => \@labels,
+ #font => $font,
+ #title => "gridlines",
+ #features => "horizontal_gridlines",
+ #hgrid => { style => "dashed", color => "#A0A0A0" },
+ )
+ or print "# ", $vert2->error, "\n";
+ ok($img9, "made the gridline image (set by methods)");
+ ok($img9->write(file => "testout/x50line_gridm.ppm"),
+ "save it");
+ cmpimg($img9, "xtestimg/x50line_grid.png");
+ }
+}
+
+END {
+ unless ($ENV{IMAGER_GRAPH_KEEP_FILES}) {
+ unlink "testout/x50line_def.ppm";
+ unlink "testout/x50line_noout.ppm";
+ unlink "testout/x50line_dashout.ppm";
+ unlink "testout/x50line_fill.ppm";
+ unlink "testout/x50line_grid.ppm";
+ unlink "testout/x50line_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
