my $chart = Imager::Graph::Sub_class->new;
my $img = $chart->draw(data=> \@data, ...)
or die $chart->error;
+ $img->write(file => 'image.png');
=head1 DESCRIPTION
use Imager qw(:handy);
use Imager::Fountain;
-$VERSION = '0.06';
+$VERSION = '0.07';
# the maximum recursion depth in determining a color, fill or number
use constant MAX_DEPTH => 10;
my $graph_data = $self->{'graph_data'} || [];
push @$graph_data, { data => $data_ref, series_name => $series_name };
+ if (defined $series_name) {
+ push @{$self->{'labels'}}, $series_name;
+ }
$self->{'graph_data'} = $graph_data;
return;
=item error
-Returns an error message. Only value if the draw() method returns false.
+Returns an error message. Only valid if the draw() method returns false.
=cut
coef=>[0.1, 0.2, 0.4, 0.6, 0.7, 0.9, 1.2,
0.9, 0.7, 0.6, 0.4, 0.2, 0.1 ] },
},
+ # controls the outline of graph elements representing data, eg. pie
+ # slices, bars or columns
outline => {
line =>'lookup(line)',
lineaa => 'lookup(lineaa)',
},
+ # controls the outline and background of the data area of the chart
+ graph =>
+ {
+ fill => "lookup(bg)",
+ outline => "lookup(fg)",
+ },
size=>256,
width=>'scale(1.5,size)',
height=>'lookup(size)',
xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
segments => Imager::Fountain->simple(
positions=>[0, 1],
- colors=>[ NC('FFFFFF'), NC('E6E2AF') ]),
+ colors=>[ NC('EFEDCF'), NC('E6E2AF') ]),
},
{
fountain =>'linear',
xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
segments => Imager::Fountain->simple(
positions=>[0, 1],
- colors=>[ NC('FFFFFF'), NC('A7A37E') ]),
+ colors=>[ NC('DCD7AB'), NC('A7A37E') ]),
},
{
fountain =>'linear',
xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
segments => Imager::Fountain->simple(
positions=>[0, 1],
- colors=>[ NC('FFFFFF'), NC('80B4A2') ]),
+ colors=>[ NC('B2E5D4'), NC('80B4A2') ]),
},
{
fountain =>'linear',
xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
segments => Imager::Fountain->simple(
positions=>[0, 1],
- colors=>[ NC('FFFFFF'), NC('046380') ]),
+ colors=>[ NC('7aaab9'), NC('046380') ]),
},
{
fountain =>'linear',
xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
segments => Imager::Fountain->simple(
positions=>[0, 1],
- colors=>[ NC('FFFFFF'), NC('877EA7') ]),
+ colors=>[ NC('c3b8e9'), NC('877EA7') ]),
},
{
fountain =>'linear',
xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
segments => Imager::Fountain->simple(
positions=>[0, 1],
- colors=>[ NC('FFFFFF'), NC('67A35E') ]),
+ colors=>[ NC('A3DF9A'), NC('67A35E') ]),
},
{
fountain =>'linear',
xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
segments => Imager::Fountain->simple(
positions=>[0, 1],
- colors=>[ NC('FFFFFF'), NC('B4726F') ]),
+ colors=>[ NC('E19C98'), NC('B4726F') ]),
},
],
colors => [
};
+$styles{'ocean_flat'} = {
+ fills=>
+ [
+ qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
+ ],
+ colors => [
+ qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
+ ],
+ fg=>'000000',
+ negative_bg=>'EEEEEE',
+ bg=>'FFFFFF',
+ features=>{ dropshadow=>1 },
+
+};
+
+
=item $self->_style_setup(\%opts)
Uses the values from %opts to build a customized hash describing the
}
# features are handled specially
- $work{features} = {};
+ my %features;
+ $work{features} = \%features;
for my $src (@search_list) {
if ($src->{features}) {
if (ref $src->{features}) {
if (ref($src->{features}) =~ /ARRAY/) {
# just set those features
for my $feature (@{$src->{features}}) {
- $work{features}{$feature} = 1;
+ if ($feature =~ /^no(.+)$/) {
+ delete $features{$1};
+ }
+ else {
+ $features{$feature} = 1;
+ }
}
}
elsif (ref($src->{features}) =~ /HASH/) {
}
else {
# just set that single feature
- $work{features}{$src->{features}} = 1;
+ if ($src->{features} =~ /^no(.+)$/) {
+ delete $features{$1};
+ }
+ else {
+ $features{$src->{features}} = 1;
+ }
}
}
}
- #use Data::Dumper;
- #print Dumper(\%work);
$self->{_style} = \%work;
}
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 {
$left > 0 or $left = 0;
$top > 0 or $top = 0;
- # newer versions of Imager let you work on just part of an image
- if ($img->can('masked') && !$self->{_style}{features}{_debugblur}) {
- my $masked = $img->masked(left=>$left, top=>$top,
- right=>$right, bottom=>$bottom);
- $masked->filter(%$filter);
+ my $masked = $img->masked(left=>$left, top=>$top,
+ right=>$right, bottom=>$bottom);
+ $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 {
- # for older versions of Imager
- my $subset = $img->crop(left=>$left, top=>$top,
- right=>$right, bottom=>$bottom);
- $subset->filter(%$filter);
- $img->paste(left=>$left, top=>$top, img=>$subset);
+ $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 => $xmax, y1 => $ymin, x2 => $xmax, y2 => $ymax, %work_opts);
+ }
+}
+
+sub _feature_enabled {
+ my ($self, $name) = @_;
+
+ return $self->{_style}{features}{$name};
+}
+
1;
__END__
projects / imager-graph.git / blobdiff