Imager::Graph - Perl extension for producing Graphs using the Imager library.

  use Imager::Graph::Sub_class;
  my $chart = Imager::Graph::Sub_class->new;
  my $img = $chart->draw(data=> \@data, ...)
    or die $chart->error;
  $img->write(file => 'image.png');

   text=>{
          color=>'lookup(fg)',
          ...
         },
   legend =>{
             color=>'lookup(text.color)',
             ...
            },

package Imager::Graph;
require 5.005;

use strict;
use vars qw($VERSION);
use Imager qw(:handy);
use Imager::Fountain;

$VERSION = '0.09';

# the maximum recursion depth in determining a color, fill or number
use constant MAX_DEPTH => 10;

my $NUM_RE = '(?:[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[eE][+-]\d+?)?)';

sub new {
  bless {}, $_[0];
}

sub set_graph_size {
  $_[0]->{'custom_style'}->{'size'} = $_[1];
}

sub set_image_width {
  $_[0]->{'custom_style'}->{'width'} = $_[1];
}

sub set_image_height {
  $_[0]->{'custom_style'}->{'height'} = $_[1];
}

sub add_data_series {
  my $self = shift;
  my $data_ref = shift;
  my $series_name = shift;

  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;
}

sub _get_data_series {
  my ($self, $opts) = @_;

  # return the data supplied to draw() if any.
  if ($opts->{data}) {
    # one or multiple series?
    my $data = $opts->{data};
    if (@$data && ref $data->[0] && ref $data->[0] =~ /ARRAY/) {
      return $data;
    }
    else {
      return [ { data => $data } ];
    }
  }

  return $self->{'graph_data'};
}

sub set_labels {
  $_[0]->{'labels'} = $_[1];
}

sub _get_labels {
  my ($self, $opts) = @_;

  $opts->{labels}
    and return $opts->{labels};

  return $_[0]->{'labels'}
}

sub set_title {
  $_[0]->{'custom_style'}->{'title'}->{'text'} = $_[1];
}

sub set_font {
  $_[0]->{'custom_style'}->{'font'} = $_[1];
}

sub set_style {
  $_[0]->{'style'} = $_[1];
}

sub _get_style {
  my ($self, $opts) = @_;

  $opts->{style}
    and return $opts->{style};

  return $self->{'style'};
}

sub error {
  $_[0]->{_errstr};
}

sub set_image_background {
  $_[0]->{'custom_style'}->{'back'} = $_[1];
}

sub set_channels {
  $_[0]->{'custom_style'}->{'channels'} = $_[1];
}

sub set_line_color {
  $_[0]->{'custom_style'}->{'line'} = $_[1];
}

sub set_title_font_size {
  $_[0]->{'custom_style'}->{'title'}->{'size'} = $_[1];
}

sub set_title_font_color {
  $_[0]->{'custom_style'}->{'title'}->{'color'} = $_[1];
}

sub set_title_horizontal_align {
  $_[0]->{'custom_style'}->{'title'}->{'halign'} = $_[1];
}

sub set_title_vertical_align {
  $_[0]->{'custom_style'}->{'title'}->{'valign'} = $_[1];
}

sub set_text_font_color {
  $_[0]->{'custom_style'}->{'text'}->{'color'} = $_[1];
}

sub set_text_font_size {
  $_[0]->{'custom_style'}->{'text'}->{'size'} = $_[1];
}

sub set_graph_background_color {
  $_[0]->{'custom_style'}->{'bg'} = $_[1];
}

sub set_graph_foreground_color {
  $_[0]->{'custom_style'}->{'fg'} = $_[1];
}

sub set_legend_font_color {
  $_[0]->{'custom_style'}->{'legend'}->{'color'} = $_[1];
}

sub set_legend_font {
  $_[0]->{'custom_style'}->{'legend'}->{'font'} = $_[1];
}

sub set_legend_font_size {
  $_[0]->{'custom_style'}->{'legend'}->{'size'} = $_[1];
}

sub set_legend_patch_size {
  $_[0]->{'custom_style'}->{'legend'}->{'patchsize'} = $_[1];
}

sub set_legend_patch_gap {
  $_[0]->{'custom_style'}->{'legend'}->{'patchgap'} = $_[1];
}

sub set_legend_horizontal_align {
  $_[0]->{'custom_style'}->{'legend'}->{'halign'} = $_[1];
}

sub set_legend_vertical_align {
  $_[0]->{'custom_style'}->{'legend'}->{'valign'} = $_[1];
}

sub set_legend_padding {
  $_[0]->{'custom_style'}->{'legend'}->{'padding'} = $_[1];
}

sub set_legend_outside_padding {
  $_[0]->{'custom_style'}->{'legend'}->{'outsidepadding'} = $_[1];
}

sub set_legend_fill {
  $_[0]->{'custom_style'}->{'legend'}->{'fill'} = $_[1];
}

sub set_legend_border {
  $_[0]->{'custom_style'}->{'legend'}->{'border'} = $_[1];
}

sub set_legend_orientation {
  $_[0]->{'custom_style'}->{'legend'}->{'orientation'} = $_[1];
}

sub set_callout_font_color {
  $_[0]->{'custom_style'}->{'callout'}->{'color'} = $_[1];
}

sub set_callout_font {
  $_[0]->{'custom_style'}->{'callout'}->{'font'} = $_[1];
}

sub set_callout_font_size {
  $_[0]->{'custom_style'}->{'callout'}->{'size'} = $_[1];
}

sub set_callout_line_color {
  $_[0]->{'custom_style'}->{'callout'}->{'line'} = $_[1];
}

sub set_callout_leader_inside_length {
  $_[0]->{'custom_style'}->{'callout'}->{'inside'} = $_[1];
}

sub set_callout_leader_outside_length {
  $_[0]->{'custom_style'}->{'callout'}->{'outside'} = $_[1];
}

sub set_callout_leader_length {
  $_[0]->{'custom_style'}->{'callout'}->{'leadlen'} = $_[1];
}

sub set_callout_gap {
  $_[0]->{'custom_style'}->{'callout'}->{'gap'} = $_[1];
}

sub set_label_font_color {
  $_[0]->{'custom_style'}->{'label'}->{'color'} = $_[1];
}

sub set_label_font {
  $_[0]->{'custom_style'}->{'label'}->{'font'} = $_[1];
}

sub set_label_font_size {
  $_[0]->{'custom_style'}->{'label'}->{'size'} = $_[1];
}

sub set_drop_shadow_fill_color {
  $_[0]->{'custom_style'}->{'dropshadow'}->{'fill'} = $_[1];
}

sub set_drop_shadow_offset {
  $_[0]->{'custom_style'}->{'dropshadow'}->{'off'} = $_[1];
}

sub set_drop_shadowXOffset {
  $_[0]->{'custom_style'}->{'dropshadow'}->{'offx'} = $_[1];
}

sub set_drop_shadowYOffset {
  $_[0]->{'custom_style'}->{'dropshadow'}->{'offy'} = $_[1];
}

sub set_drop_shadow_filter {
  $_[0]->{'custom_style'}->{'dropshadow'}->{'filter'} = $_[1];
}

sub set_outline_color {
  $_[0]->{'custom_style'}->{'outline'}->{'line'} = $_[1];
}

sub set_data_area_fills {
  $_[0]->{'custom_style'}->{'fills'} = $_[1];
}

sub set_data_line_colors {
  $_[0]->{'custom_style'}->{'colors'} = $_[1];
}

sub show_legend {
    $_[0]->{'custom_style'}->{'features'}->{'legend'} = 1;
}

sub show_outline {
    $_[0]->{'custom_style'}->{'features'}->{'outline'} = 1;
}

sub show_labels {
    $_[0]->{'custom_style'}->{'features'}->{'labels'} = 1;
}

sub show_drop_shadow {
    $_[0]->{'custom_style'}->{'features'}->{'dropshadow'} = 1;
}

sub reset_features {
    $_[0]->{'custom_style'}->{'features'} = {};
    $_[0]->{'custom_style'}->{'features'}->{'reset'} = 1;
}

my %style_defs =
  (
   back=> 'lookup(bg)',
   line=> 'lookup(fg)',
   aa => 1,
   text=>{
          color => 'lookup(fg)',
          font  => 'lookup(font)',
          size  => 14,
	  aa    => 'lookup(aa)',
         },
   title=>{ 
           color  => 'lookup(text.color)', 
           font   => 'lookup(text.font)',
           halign => 'center', 
           valign => 'top',
           size   => 'scale(text.size,2.0)',
	   aa     => 'lookup(text.aa)',
          },
   legend =>{
             color          => 'lookup(text.color)',
             font           => 'lookup(text.font)',
	     aa             => 'lookup(text.aa)',
             size           => 'lookup(text.size)',
             patchsize      => 'scale(legend.size,0.9)',
             patchgap       => 'scale(legend.patchsize,0.3)',
             patchborder    => 'lookup(line)',
             halign         => 'right',
             valign         => 'top',
             padding        => 'scale(legend.size,0.3)',
             outsidepadding => 'scale(legend.padding,0.4)',
            },
   callout => {
               color    => 'lookup(text.color)',
               font     => 'lookup(text.font)',
               size     => 'lookup(text.size)',
               line     => 'lookup(line)',
               inside   => 'lookup(callout.size)',
               outside  => 'lookup(callout.size)',
               leadlen  => 'scale(0.8,callout.size)',
               gap      => 'scale(callout.size,0.3)',
	       aa       => 'lookup(text.aa)',
	       lineaa   => 'lookup(lineaa)',
              },
   label => {
             font          => 'lookup(text.font)',
             size          => 'lookup(text.size)',
             color         => 'lookup(text.color)',
             hpad          => 'lookup(label.pad)',
             vpad          => 'lookup(label.pad)',
             pad           => 'scale(label.size,0.2)',
             pcformat      => sub { sprintf "%s (%.0f%%)", $_[0], $_[1] },
             pconlyformat  => sub { sprintf "%.1f%%", $_[0] },
	     aa            => 'lookup(text.aa)',
	     lineaa        => 'lookup(lineaa)',
             },
   dropshadow => {
                  fill    => { solid => Imager::Color->new(0, 0, 0, 96) },
                  off     => 'scale(0.4,text.size)',
                  offx    => 'lookup(dropshadow.off)',
                  offy    => 'lookup(dropshadow.off)',
                  filter  => { type=>'conv', 
                              # this needs a fairly heavy blur
                              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)',

   # yes, the handling of fill and line AA is inconsistent, lack of
   # forethought, unfortunately
   fill => {
	    aa => 'lookup(aa)',
	   },
   lineaa => 'lookup(aa)',

    line_markers =>[
      { shape => 'circle',   radius => 4 },
      { shape => 'square',   radius => 4 },
      { shape => 'diamond',  radius => 4 },
      { shape => 'triangle', radius => 4 },
      { shape => 'x',        radius => 4 },
      { shape => 'plus',     radius => 4 },
    ],
  );

sub _error {
  my ($self, $error) = @_;

  $self->{_errstr} = $error;

  return;
}

sub _style_defs {
  \%style_defs;
}

# Let's make the default something that looks really good, so folks will be interested enough to customize the style.
my $def_style = 'fount_lin';

my %styles =
  (
   primary =>
   {
    fills=>
    [
     qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
    ],
    fg=>'000000',
    negative_bg=>'EEEEEE',
    bg=>'E0E0E0',
    legend=>
    {
     #patchborder=>'000000'
    },
   },
   primary_red =>
   {
    fills=>
    [
     qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
    ],
    fg=>'000000',
    negative_bg=>'EEEEEE',
    bg=>'C08080',
    legend=>
    {
     patchborder=>'000000'
    },
   },
   mono =>
   {
    fills=>
    [
     { hatch=>'slash2' },
     { hatch=>'slosh2' },
     { hatch=>'vline2' },
     { hatch=>'hline2' },
     { hatch=>'cross2' },
     { hatch=>'grid2' },
     { hatch=>'stipple3' },
     { hatch=>'stipple2' },
    ],
    channels=>1,
    bg=>'FFFFFF',
    fg=>'000000',
    negative_bg=>'EEEEEE',
    features=>{ outline=>1 },
    pie =>{
           blur=>undef,
          },
    aa => 0,
    line_markers =>
    [
     { shape => "x", radius => 4 },
     { shape => "plus", radius => 4 },
     { shape => "open_circle", radius => 4 },
     { shape => "open_diamond", radius => 5 },
     { shape => "open_square", radius => 4 },
     { shape => "open_triangle", radius => 4 },
     { shape => "x", radius => 8 },
     { shape => "plus", radius => 8 },
     { shape => "open_circle", radius => 8 },
     { shape => "open_diamond", radius => 10 },
     { shape => "open_square", radius => 8 },
     { shape => "open_triangle", radius => 8 },
    ],
   },
   fount_lin =>
   {
    fills=>
    [
     { fountain=>'linear',
       xa_ratio=>0.13, ya_ratio=>0.13, xb_ratio=>0.87, yb_ratio=>0.87,
       segments => Imager::Fountain->simple(positions=>[0, 1],
                                            colors=>[ NC('FFC0C0'), NC('FF0000') ]),
     },
     { 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('C0FFC0'), NC('00FF00') ]),
     },
     { 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('C0C0FF'), NC('0000FF') ]),
     },
     { 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('FFFFC0'), NC('FFFF00') ]),
     },
     { 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('C0FFFF'), NC('00FFFF') ]),
     },
     { 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('FFC0FF'), NC('FF00FF') ]),
     },
    ],
    colors  => [
     qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
    ],
    back=>{ 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('6060FF'), NC('60FF60') ]) },
    fg=>'000000',
    negative_bg=>'EEEEEE',
    bg=>'FFFFFF',
    features=>{ dropshadow=>1 },
   },
   fount_rad =>
   {
    fills=>
    [
     { fountain=>'radial',
       xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
       segments => Imager::Fountain->simple(positions=>[0, 1],
                                            colors=>[ NC('FF8080'), NC('FF0000') ]),
     },
     { fountain=>'radial',
       xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
       segments => Imager::Fountain->simple(positions=>[0, 1],
                                            colors=>[ NC('80FF80'), NC('00FF00') ]),
     },
     { fountain=>'radial',
       xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
       segments => Imager::Fountain->simple(positions=>[0, 1],
                                            colors=>[ NC('808080FF'), NC('0000FF') ]),
     },
     { fountain=>'radial',
       xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
       segments => Imager::Fountain->simple(positions=>[0, 1],
                                            colors=>[ NC('FFFF80'), NC('FFFF00') ]),
     },
     { fountain=>'radial',
       xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
       segments => Imager::Fountain->simple(positions=>[0, 1],
                                            colors=>[ NC('80FFFF'), NC('00FFFF') ]),
     },
     { fountain=>'radial',
       xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
       segments => Imager::Fountain->simple(positions=>[0, 1],
                                            colors=>[ NC('FF80FF'), NC('FF00FF') ]),
     },
    ],
    colors  => [
     qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
    ],
    back=>{ 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('6060FF'), NC('60FF60') ]) },
    fg=>'000000',
    negative_bg=>'EEEEEE',
    bg=>'FFFFFF',
   }
  );

$styles{'ocean'} = {
    fills  => [
             {
              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('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('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('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('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('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('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('E19C98'), NC('B4726F') ]),
            },
    ],
    colors  => [
     qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
    ],
    fg=>'000000',
    negative_bg=>'EEEEEE',
    bg=>'FFFFFF',
    features=>{ dropshadow=>1 },

};

$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 },

};

sub _style_setup {
  my ($self, $opts) = @_;
  my $style_defs = $self->_style_defs;
  my $style;

  my $pre_def_style = $self->_get_style($opts);
  my $api_style = $self->{'custom_style'} || {};
  $style = $styles{$pre_def_style} if $pre_def_style;

  $style ||= $styles{$def_style};

  my @search_list = ( $style_defs, $style, $api_style, $opts);
  my %work;

  my @composite = $self->_composite();
  my %composite;
  @composite{@composite} = @composite;

  for my $src (@search_list) {
    for my $key (keys %$src) {
      if ($composite{$key}) {
        $work{$key} = {} unless exists $work{$key};
        if (ref $src->{$key}) {
          # some keys have sub values, especially text
          @{$work{$key}}{keys %{$src->{$key}}} = values %{$src->{$key}};
        }
        else {
          # assume it's the text for a title or something
          $work{$key}{text} = $src->{$key};
        }
      }
      else {
        $work{$key} = $src->{$key}
	  if defined $src->{$key}; # $opts with pmichauds new accessor handling
      }
    }
  }

  # features are handled specially
  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}}) {
	    if ($feature =~ /^no(.+)$/) {
	      delete $features{$1};
	    }
	    else {
	      $features{$feature} = 1;
	    }
          }
        }
        elsif (ref($src->{features}) =~ /HASH/) {
          if ($src->{features}{reset}) {
            $work{features} = {}; # only the ones the user specifies
          }
          @{$work{features}}{keys %{$src->{features}}} =
            values(%{$src->{features}});
        }
      }
      else {
        # just set that single feature
	if ($src->{features} =~ /^no(.+)$/) {
	  delete $features{$1};
	}
	else {
	  $features{$src->{features}} = 1;
	}
      }
    }
  }

  $self->{_style} = \%work;
}

sub _get_thing {
  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;
  if (ref $what) {
    return $what;
  }
  elsif ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
    @depth < MAX_DEPTH
      or return $self->_error("too many levels of recursion in lookup(@depth)");
    return $self->_get_thing($1, @depth);
  }
  else {
    return $what;
  }
}

sub _get_number {
  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("$name is undef (@depth)");

  if (ref $what) {
    if ($what =~ /CODE/) {
      $what = $what->($self, $name);
    }
  }
  else {
    if ($what =~ /^lookup\(([\w.]+)\)$/) {
      @depth < MAX_DEPTH
        or return $self->_error("too many levels of recursion in lookup (@depth)");
      return $self->_get_number($1, @depth);
    }
    elsif ($what =~ /^scale\(
                                        ((?:[a-z][\w.]*)|$NUM_RE)
                                        ,
                                        ((?:[a-z][\w.]*)|$NUM_RE)\)$/x) {
      my ($left, $right) = ($1, $2);
      unless ($left =~ /^$NUM_RE$/) {
        @depth < MAX_DEPTH 
          or return $self->_error("too many levels of recursion in scale (@depth)");
        $left = $self->_get_number($left, @depth);
      }
      unless ($right =~ /^$NUM_RE$/) {
        @depth < MAX_DEPTH 
          or return $self->_error("too many levels of recursion in scale (@depth)");
        $right = $self->_get_number($right, @depth);
      }
      return $left * $right;
    }
    else {
      return $what+0;
    }
  }
}

sub _get_integer {
  my ($self, $name, @depth) = @_;

  my $number = $self->_get_number($name, @depth)
    or return;

  return sprintf("%.0f", $number);
}

sub _get_color {
  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("$name was undefined (@depth)");

  unless (ref $what) {
    if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
      @depth < MAX_DEPTH or
        return $self->_error("too many levels of recursion in lookup (@depth)");

      return $self->_get_color($1, @depth);
    }
    $what = Imager::Color->new($what);
  }

  $what;
}

sub _translate_fill {
  my ($self, $what, $box, @depth) = @_;

  if (ref $what) {
    if (UNIVERSAL::isa($what, "Imager::Color")) {
      return ( color=>Imager::Color->new($what), filled=>1 );
    }
    else {
      # a general fill
      # default to normal combine mode
      my %work = ( combine => 'normal', %$what );
      if ($what->{hatch}) {
        if (!$work{fg}) {
          $work{fg} = $self->_get_color('fg')
            or return;
        }
        if (!$work{bg}) {
          $work{bg} = $self->_get_color('bg')
            or return;
        }
        return ( fill=>\%work );
      }
      elsif ($what->{fountain}) {
        for my $key (qw(xa ya xb yb)) {
          if (exists $work{"${key}_ratio"}) {
            if ($key =~ /^x/) {
              $work{$key} = $box->[0] + $work{"${key}_ratio"} 
                * ($box->[2] - $box->[0]);
            }
            else {
              $work{$key} = $box->[1] + $work{"${key}_ratio"} 
                * ($box->[3] - $box->[1]);
            }
          }
        }
        return ( fill=>\%work );
      }
      else {
        return ( fill=> \%work );
      }
    }
  }
  else {
    if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
      return $self->_get_fill($1, $box, @depth);
    }
    else {
      # assumed to be an Imager::Color single value
      return ( color=>Imager::Color->new($what), filled=>1 );
    }
  }
}

sub _data_fill {
  my ($self, $index, $box) = @_;

  my $fills = $self->{_style}{fills};
  return $self->_translate_fill($fills->[$index % @$fills], $box,
                                "data.$index");
}

sub _data_color {
  my ($self, $index) = @_;

  my $colors = $self->{'_style'}{'colors'} || [];
  my $fills  = $self->{'_style'}{'fills'} || [];

  # Try to just use a fill, so non-fountain styles don't need
  # to have a duplicated set of fills and colors
  my $fill = $fills->[$index % @$fills];
  if (!ref $fill) {
    return $fill;
  }

  if (@$colors) {
    return $colors->[$index % @$colors] || '000000';
  }
  return '000000';
}

sub _get_fill {
  my ($self, $name, $box, @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 fill $name found");

  return $self->_translate_fill($what, $box, @depth);
}

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 );
    }
  }
}

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

  my $width = $self->_get_number('width') || 256;
  my $height = $self->_get_number('height') || 256;
  my $channels = $self->{_style}{channels};

  $channels ||= 3;

  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]));

  $self->{_image} = $img;

  return $img;
}

sub _get_image {
  my $self = shift;

  return $self->{'_image'};
}

sub _text_style {
  my ($self, $name) = @_;

  my %work;

  if ($self->{_style}{$name}) {
    %work = %{$self->{_style}{$name}};
  }
  else {
    %work = %{$self->{_style}{text}};
  }
  $work{font}
    or return $self->_error("$name has no font parameter");

  $work{font} = $self->_get_thing("$name.font")
    or return $self->_error("No $name.font defined, either set $name.font or font to a font");
  UNIVERSAL::isa($work{font}, "Imager::Font")
      or return $self->_error("$name.font is not a font");
  if ($work{color} && !ref $work{color}) {
    $work{color} = $self->_get_color("$name.color")
      or return;
  }
  $work{size} = $self->_get_number("$name.size");
  $work{sizew} = $self->_get_number("$name.sizew")
    if $work{sizew};
  $work{aa} = $self->_get_number("$name.aa");

  %work;
}

sub _text_bbox {
  my ($self, $text, $name) = @_;

  my %text_info = $self->_text_style($name)
    or return;

  my @bbox = $text_info{font}->bounding_box(%text_info, string=>$text,
                                            canon=>1);

  return @bbox[0..3];
}

sub _line_style {
  my ($self, $name) = @_;

  my %line;
  $line{color} = $self->_get_color("$name.line")
    or return;
  $line{aa} = $self->_get_number("$name.lineaa");
  defined $line{aa} or $line{aa} = $self->_get_number("aa");

  return %line;
}

sub _align_box {
  my ($self, $box, $chart_box, $name) = @_;

  my $halign = $self->{_style}{$name}{halign}
    or $self->_error("no halign for $name");
  my $valign = $self->{_style}{$name}{valign};

  if ($halign eq 'right') {
    $box->[0] += $chart_box->[2] - $box->[2];
  }
  elsif ($halign eq 'left') {
    $box->[0] = $chart_box->[0];
  }
  elsif ($halign eq 'center' || $halign eq 'centre') {
    $box->[0] = ($chart_box->[0] + $chart_box->[2] - $box->[2])/2;
  }
  else {
    return $self->_error("invalid halign $halign for $name");
  }

  if ($valign eq 'top') {
    $box->[1] = $chart_box->[1];
  }
  elsif ($valign eq 'bottom') {
    $box->[1] = $chart_box->[3] - $box->[3];
  }
  elsif ($valign eq 'center' || $valign eq 'centre') {
    $box->[1] = ($chart_box->[1] + $chart_box->[3] - $box->[3])/2;
  }
  else {
    return $self->_error("invalid valign $valign for $name");
  }
  $box->[2] += $box->[0];
  $box->[3] += $box->[1];
}

sub _remove_box {
  my ($self, $chart_box, $object_box) = @_;

  my $areax;
  my $areay;
  if ($object_box->[0] - $chart_box->[0] 
      < $chart_box->[2] - $object_box->[2]) {
    $areax = ($object_box->[2] - $chart_box->[0]) 
      * ($chart_box->[3] - $chart_box->[1]);
  }
  else {
    $areax = ($chart_box->[2] - $object_box->[0]) 
      * ($chart_box->[3] - $chart_box->[1]);
  }

  if ($object_box->[1] - $chart_box->[1] 
      < $chart_box->[3] - $object_box->[3]) {
    $areay = ($object_box->[3] - $chart_box->[1]) 
      * ($chart_box->[2] - $chart_box->[0]);
  }
  else {
    $areay = ($chart_box->[3] - $object_box->[1]) 
      * ($chart_box->[2] - $chart_box->[0]);
  }

  if ($areay < $areax) {
    if ($object_box->[1] - $chart_box->[1] 
        < $chart_box->[3] - $object_box->[3]) {
      $chart_box->[1] = $object_box->[3];
    }
    else {
      $chart_box->[3] = $object_box->[1];
    }
  }
  else {
    if ($object_box->[0] - $chart_box->[0] 
        < $chart_box->[2] - $object_box->[2]) {
      $chart_box->[0] = $object_box->[2];
    }
    else {
      $chart_box->[2] = $object_box->[0];
    }
  }
}

sub _draw_legend {
  my ($self, $img, $labels, $chart_box) = @_;

  my $orient = $self->_get_thing('legend.orientation');
  defined $orient or $orient = 'vertical';

  if ($orient eq 'vertical') {
    return $self->_draw_legend_vertical($img, $labels, $chart_box);
  }
  elsif ($orient eq 'horizontal') {
    return $self->_draw_legend_horizontal($img, $labels, $chart_box);
  }
  else {
    return $self->_error("Unknown legend.orientation $orient");
  }
}

sub _draw_legend_horizontal {
  my ($self, $img, $labels, $chart_box) = @_;

  defined(my $padding = $self->_get_integer('legend.padding'))
    or return;
  my $patchsize = $self->_get_integer('legend.patchsize')
    or return;
  defined(my $gap = $self->_get_integer('legend.patchgap'))
    or return;

  my $minrowsize = $patchsize + $gap;
  my ($width, $height) = (0,0);
  my $row_height = $minrowsize;
  my $pos = 0;
  my @sizes;
  my @offsets;
  for my $label (@$labels) {
    my @text_box = $self->_text_bbox($label, 'legend')
      or return;
    push(@sizes, \@text_box);
    my $entry_width = $patchsize + $gap + $text_box[2];
    if ($pos == 0) {
      # never re-wrap the first entry
      push @offsets, [ 0, $height ];
    }
    else {
      if ($pos + $gap + $entry_width > $chart_box->[2]) {
        $pos = 0;
        $height += $row_height;
      }
      push @offsets, [ $pos, $height ];
    }
    my $entry_right = $pos + $entry_width;
    $pos += $gap + $entry_width;
    $entry_right > $width and $width = $entry_right;
    if ($text_box[3] > $row_height) {
      $row_height = $text_box[3];
    }
  }
  $height += $row_height;
  my @box = ( 0, 0, $width + $padding * 2, $height + $padding * 2 );
  my $outsidepadding = 0;
  if ($self->{_style}{legend}{border}) {
    defined($outsidepadding = $self->_get_integer('legend.outsidepadding'))
      or return;
    $box[2] += 2 * $outsidepadding;
    $box[3] += 2 * $outsidepadding;
  }
  $self->_align_box(\@box, $chart_box, 'legend')
    or return;
  if ($self->{_style}{legend}{fill}) {
    $img->box(xmin=>$box[0]+$outsidepadding, 
              ymin=>$box[1]+$outsidepadding, 
              xmax=>$box[2]-$outsidepadding, 
              ymax=>$box[3]-$outsidepadding,
             $self->_get_fill('legend.fill', \@box));
  }
  $box[0] += $outsidepadding;
  $box[1] += $outsidepadding;
  $box[2] -= $outsidepadding;
  $box[3] -= $outsidepadding;
  my %text_info = $self->_text_style('legend')
    or return;
  my $patchborder;
  if ($self->{_style}{legend}{patchborder}) {
    $patchborder = $self->_get_color('legend.patchborder')
      or return;
  }
  
  my $dataindex = 0;
  for my $label (@$labels) {
    my ($left, $top) = @{$offsets[$dataindex]};
    $left += $box[0] + $padding;
    $top += $box[1] + $padding;
    my $textpos = $left + $patchsize + $gap;
    my @patchbox = ( $left, $top,
                     $left + $patchsize, $top + $patchsize );
    my @fill = $self->_data_fill($dataindex, \@patchbox)
      or return;
    $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize,
               ymax=>$top + $patchsize, @fill);
    if ($self->{_style}{legend}{patchborder}) {
      $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize,
                ymax=>$top + $patchsize,
                color=>$patchborder);
    }
    $img->string(%text_info, x=>$textpos, 'y'=>$top + $patchsize, 
                 text=>$label);

    ++$dataindex;
  }
  if ($self->{_style}{legend}{border}) {
    my $border_color = $self->_get_color('legend.border')
      or return;
    $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3],
              color=>$border_color);
  }
  $self->_remove_box($chart_box, \@box);
  1;
}

sub _draw_legend_vertical {
  my ($self, $img, $labels, $chart_box) = @_;

  defined(my $padding = $self->_get_integer('legend.padding'))
    or return;
  my $patchsize = $self->_get_integer('legend.patchsize')
    or return;
  defined(my $gap = $self->_get_integer('legend.patchgap'))
    or return;
  my $minrowsize = $patchsize + $gap;
  my ($width, $height) = (0,0);
  my @sizes;
  for my $label (@$labels) {
    my @box = $self->_text_bbox($label, 'legend')
      or return;
    push(@sizes, \@box);
    $width = $box[2] if $box[2] > $width;
    if ($minrowsize > $box[3]) {
      $height += $minrowsize;
    }
    else {
      $height += $box[3];
    }
  }
  my @box = (0, 0, 
             $width + $patchsize + $padding * 2 + $gap,
             $height + $padding * 2 - $gap);
  my $outsidepadding = 0;
  if ($self->{_style}{legend}{border}) {
    defined($outsidepadding = $self->_get_integer('legend.outsidepadding'))
      or return;
    $box[2] += 2 * $outsidepadding;
    $box[3] += 2 * $outsidepadding;
  }
  $self->_align_box(\@box, $chart_box, 'legend')
    or return;
  if ($self->{_style}{legend}{fill}) {
    $img->box(xmin=>$box[0]+$outsidepadding, 
              ymin=>$box[1]+$outsidepadding, 
              xmax=>$box[2]-$outsidepadding, 
              ymax=>$box[3]-$outsidepadding,
             $self->_get_fill('legend.fill', \@box));
  }
  $box[0] += $outsidepadding;
  $box[1] += $outsidepadding;
  $box[2] -= $outsidepadding;
  $box[3] -= $outsidepadding;
  my $ypos = $box[1] + $padding;
  my $patchpos = $box[0]+$padding;
  my $textpos = $patchpos + $patchsize + $gap;
  my %text_info = $self->_text_style('legend')
    or return;
  my $patchborder;
  if ($self->{_style}{legend}{patchborder}) {
    $patchborder = $self->_get_color('legend.patchborder')
      or return;
  }
  my $dataindex = 0;
  for my $label (@$labels) {
    my @patchbox = ( $patchpos - $patchsize/2, $ypos - $patchsize/2,
                     $patchpos + $patchsize * 3 / 2, $ypos + $patchsize*3/2 );

    my @fill;
    if ($self->_draw_flat_legend()) {
      @fill = (color => $self->_data_color($dataindex), filled => 1);
    }
    else {
      @fill = $self->_data_fill($dataindex, \@patchbox)
        or return;
    }
    $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
               ymax=>$ypos + $patchsize, @fill);
    if ($self->{_style}{legend}{patchborder}) {
      $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
                ymax=>$ypos + $patchsize,
                color=>$patchborder);
    }
    $img->string(%text_info, x=>$textpos, 'y'=>$ypos + $patchsize, 
                 text=>$label);

    my $step = $patchsize + $gap;
    if ($minrowsize < $sizes[$dataindex][3]) {
      $ypos += $sizes[$dataindex][3];
    }
    else {
      $ypos += $minrowsize;
    }
    ++$dataindex;
  }
  if ($self->{_style}{legend}{border}) {
    my $border_color = $self->_get_color('legend.border')
      or return;
    $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3],
              color=>$border_color);
  }
  $self->_remove_box($chart_box, \@box);
  1;
}

sub _draw_title {
  my ($self, $img, $chart_box) = @_;

  my $title = $self->{_style}{title}{text};
  my @box = $self->_text_bbox($title, 'title')
    or return;
  my $yoff = $box[1];
  @box[0,1] = (0,0);
  $self->_align_box(\@box, $chart_box, 'title');
  my %text_info = $self->_text_style('title')
    or return;
  $img->string(%text_info, x=>$box[0], 'y'=>$box[3] + $yoff, text=>$title);
  $self->_remove_box($chart_box, \@box);
  1;
}

sub _small_extent {
  my ($self, $box) = @_;

  if ($box->[2] - $box->[0] > $box->[3] - $box->[1]) {
    return $box->[3] - $box->[1];
  }
  else {
    return $box->[2] - $box->[0];
  }
}

sub _draw_flat_legend {
  return 0;
}

sub _composite {
  qw(title legend text label dropshadow outline callout graph);
}

sub _filter_region {
  my ($self, $img, $left, $top, $right, $bottom, $filter) = @_;

  unless (ref $filter) {
    my $name = $filter;
    $filter = $self->_get_thing($name)
      or return;
    $filter->{type}
      or return $self->_error("no type for filter $name");
  }

  $left > 0 or $left = 0;
  $top > 0 or $top = 0;

  my $masked = $img->masked(left=>$left, top=>$top,
			    right=>$right, bottom=>$bottom);
  $masked->filter(%$filter);
}

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;
  }
}

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);
  }
}