lib/Imager/Graph/Vertical.pm

   1 package Imager::Graph::Vertical;
   2
   3 =head1 NAME
   4
   5 Imager::Graph::Vertical- A super class for line/bar/column/area charts
   6
   7 =head1 SYNOPSIS
   8
   9   use Imager::Graph::Vertical;
  10
  11   my $vert = Imager::Graph::Vertical->new;
  12   $vert->add_column_data_series(\@data, "My data");
  13   $vert->add_area_data_series(\@data2, "Area data");
  14   $vert->add_stacked_column_data_series(\@data3, "stacked data");
  15   $vert->add_line_data_series(\@data4, "line data");
  16   my $img = $vert->draw();
  17
  18   use Imager::Graph::Column;
  19   my $column = Imager::Graph::Column->new;
  20   $column->add_data_series(\@data, "my data");
  21   my $img = $column->draw();
  22
  23 =head1 DESCRIPTION
  24
  25 This is a base class that implements the functionality for column,
  26 stacked column, line and area charts where the dependent variable is
  27 represented in changes in the vertical position.
  28
  29 The subclasses, L<Imager::Graph::Column>,
  30 L<Imager::Graph::StackedColumn>, L<Imager::Graph::Line> and
  31 L<Imager::Graph::Area> simply provide default data series types.
  32
  33 =head1 METHODS
  34
  35 =cut
  36
  37 use strict;
  38 use vars qw(@ISA);
  39 use Imager::Graph;
  40 @ISA = qw(Imager::Graph);
  41 use Imager::Fill;
  42
  43 use constant STARTING_MIN_VALUE => 99999;
  44
  45 =over
  46
  47 =item add_data_series(\@data, $series_name)
  48
  49 Add a data series to the graph, of the default type.  This requires
  50 that the graph object be one of the derived graph classes.
  51
  52 =cut
  53
  54 sub add_data_series {
  55   my $self = shift;
  56   my $data_ref = shift;
  57   my $series_name = shift;
  58
  59   my $series_type = $self->_get_default_series_type();
  60   $self->_add_data_series($series_type, $data_ref, $series_name);
  61
  62   return;
  63 }
  64
  65 =item add_column_data_series(\@data, $series_name)
  66
  67 Add a column data series to the graph.
  68
  69 =cut
  70
  71 sub add_column_data_series {
  72   my $self = shift;
  73   my $data_ref = shift;
  74   my $series_name = shift;
  75
  76   $self->_add_data_series('column', $data_ref, $series_name);
  77
  78   return;
  79 }
  80
  81 =item add_stacked_column_data_series(\@data, $series_name)
  82
  83 Add a stacked column data series to the graph.
  84
  85 =cut
  86
  87 sub add_stacked_column_data_series {
  88   my $self = shift;
  89   my $data_ref = shift;
  90   my $series_name = shift;
  91
  92   $self->_add_data_series('stacked_column', $data_ref, $series_name);
  93
  94   return;
  95 }
  96
  97 =item add_line_data_series(\@data, $series_name)
  98
  99 Add a line data series to the graph.
 100
 101 =cut
 102
 103 sub add_line_data_series {
 104   my $self = shift;
 105   my $data_ref = shift;
 106   my $series_name = shift;
 107
 108   $self->_add_data_series('line', $data_ref, $series_name);
 109
 110   return;
 111 }
 112
 113 =item add_area_data_series(\@data, $series_name)
 114
 115 Add a area data series to the graph.
 116
 117 =cut
 118
 119 sub add_area_data_series {
 120   my $self = shift;
 121   my $data_ref = shift;
 122   my $series_name = shift;
 123
 124   $self->_add_data_series('area', $data_ref, $series_name);
 125
 126   return;
 127 }
 128
 129 =item set_y_max($value)
 130
 131 Sets the maximum y value to be displayed.  This will be ignored if the
 132 y_max is lower than the highest value.
 133
 134 =cut
 135
 136 sub set_y_max {
 137   $_[0]->{'custom_style'}->{'y_max'} = $_[1];
 138 }
 139
 140 =item set_y_min($value)
 141
 142 Sets the minimum y value to be displayed.  This will be ignored if the
 143 y_min is higher than the lowest value.
 144
 145 =cut
 146
 147 sub set_y_min {
 148   $_[0]->{'custom_style'}->{'y_min'} = $_[1];
 149 }
 150
 151 =item set_column_padding($int)
 152
 153 Sets the padding between columns.  This is a percentage of the column
 154 width.  Defaults to 0.
 155
 156 =cut
 157
 158 sub set_column_padding {
 159   $_[0]->{'custom_style'}->{'column_padding'} = $_[1];
 160 }
 161
 162 =item set_range_padding($percentage)
 163
 164 Sets the padding to be used, as a percentage.  For example, if your
 165 data ranges from 0 to 10, and you have a 20 percent padding, the y
 166 axis will go to 12.
 167
 168 Defaults to 10.  This attribute is ignored for positive numbers if
 169 set_y_max() has been called, and ignored for negative numbers if
 170 set_y_min() has been called.
 171
 172 =cut
 173
 174 sub set_range_padding {
 175   $_[0]->{'custom_style'}->{'range_padding'} = $_[1];
 176 }
 177
 178 =item set_negative_background($color)
 179
 180 Sets the background color used below the x axis.
 181
 182 =cut
 183
 184 sub set_negative_background {
 185   $_[0]->{'custom_style'}->{'negative_bg'} = $_[1];
 186 }
 187
 188 =item draw()
 189
 190 Draw the graph
 191
 192 =cut
 193
 194 sub draw {
 195   my ($self, %opts) = @_;
 196
 197   if (!$self->_valid_input()) {
 198     return;
 199   }
 200
 201   $self->_style_setup(\%opts);
 202
 203   my $style = $self->{_style};
 204
 205   $self->_make_img
 206     or return;
 207
 208   my $img = $self->_get_image()
 209     or return;
 210
 211   my @image_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
 212   $self->_set_image_box(\@image_box);
 213
 214   my @chart_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
 215   $self->_draw_legend(\@chart_box);
 216   if ($style->{title}{text}) {
 217     $self->_draw_title($img, \@chart_box)
 218       or return;
 219   }
 220
 221   # Scale the graph box down to the widest graph that can cleanly hold the # of columns.
 222   return unless $self->_get_data_range();
 223   $self->_remove_tics_from_chart_box(\@chart_box, \%opts);
 224   my $column_count = $self->_get_column_count();
 225
 226   my $width = $self->_get_number('width');
 227   my $height = $self->_get_number('height');
 228
 229   my $graph_width = $chart_box[2] - $chart_box[0];
 230   my $graph_height = $chart_box[3] - $chart_box[1];
 231
 232   my $col_width = ($graph_width - 1) / $column_count;
 233   if ($col_width > 1) {
 234     $graph_width = int($col_width) * $column_count + 1;
 235   }
 236   else {
 237     $graph_width = $col_width * $column_count + 1;
 238   }
 239
 240   my $tic_count = $self->_get_y_tics();
 241   my $tic_distance = ($graph_height-1) / ($tic_count - 1);
 242   $graph_height = int($tic_distance * ($tic_count - 1));
 243
 244   my $top  = $chart_box[1];
 245   my $left = $chart_box[0];
 246
 247   $self->{'_style'}{'graph_width'} = $graph_width;
 248   $self->{'_style'}{'graph_height'} = $graph_height;
 249
 250   my @graph_box = ($left, $top, $left + $graph_width, $top + $graph_height);
 251   $self->_set_graph_box(\@graph_box);
 252
 253   my @fill_box = ( $left, $top, $left+$graph_width, $top+$graph_height );
 254   if ($self->_feature_enabled("graph_outline")) {
 255     my @line = $self->_get_line("graph.outline")
 256       or return;
 257
 258     $self->_box(
 259                 @line,
 260                 box => \@fill_box,
 261                 img => $img,
 262                );
 263     ++$fill_box[0];
 264     ++$fill_box[1];
 265     --$fill_box[2];
 266     --$fill_box[3];
 267   }
 268
 269   $img->box(
 270             $self->_get_fill('graph.fill'),
 271             box => \@fill_box,
 272            );
 273
 274   my $min_value = $self->_get_min_value();
 275   my $max_value = $self->_get_max_value();
 276   my $value_range = $max_value - $min_value;
 277
 278   my $zero_position;
 279   if ($value_range) {
 280     $zero_position =  $top + $graph_height - (-1*$min_value / $value_range) * ($graph_height-1);
 281   }
 282
 283   if ($min_value < 0) {
 284     $img->box(
 285             color   => $self->_get_color('negative_bg'),
 286             xmin    => $left + 1,
 287             xmax    => $left+$graph_width- 1,
 288             ymin    => $zero_position,
 289             ymax    => $top+$graph_height - 1,
 290             filled  => 1,
 291     );
 292     $img->line(
 293             x1 => $left+1,
 294             y1 => $zero_position,
 295             x2 => $left + $graph_width,
 296             y2 => $zero_position,
 297             color => $self->_get_color('outline.line'),
 298     );
 299   }
 300
 301   $self->_reset_series_counter();
 302
 303   if ($self->_get_data_series()->{'stacked_column'}) {
 304     return unless $self->_draw_stacked_columns();
 305   }
 306   if ($self->_get_data_series()->{'column'}) {
 307     return unless $self->_draw_columns();
 308   }
 309   if ($self->_get_data_series()->{'line'}) {
 310     return unless $self->_draw_lines();
 311   }
 312   if ($self->_get_data_series()->{'area'}) {
 313     return unless $self->_draw_area();
 314   }
 315
 316   if ($self->_get_y_tics()) {
 317     $self->_draw_y_tics();
 318   }
 319   if ($self->_get_labels(\%opts)) {
 320     $self->_draw_x_tics(\%opts);
 321   }
 322
 323   return $self->_get_image();
 324 }
 325
 326 sub _get_data_range {
 327   my $self = shift;
 328
 329   my $max_value = 0;
 330   my $min_value = 0;
 331   my $column_count = 0;
 332
 333   my ($sc_min, $sc_max, $sc_cols) = $self->_get_stacked_column_range();
 334   my ($c_min, $c_max, $c_cols) = $self->_get_column_range();
 335   my ($l_min, $l_max, $l_cols) = $self->_get_line_range();
 336   my ($a_min, $a_max, $a_cols) = $self->_get_area_range();
 337
 338   # These are side by side...
 339   $sc_cols += $c_cols;
 340
 341   $min_value = $self->_min(STARTING_MIN_VALUE, $sc_min, $c_min, $l_min, $a_min);
 342   $max_value = $self->_max(0, $sc_max, $c_max, $l_max, $a_max);
 343
 344   my $config_min = $self->_get_number('y_min');
 345   my $config_max = $self->_get_number('y_max');
 346
 347   if (defined $config_max && $config_max < $max_value) {
 348     $config_max = undef;
 349   }
 350   if (defined $config_min && $config_min > $min_value) {
 351     $config_min = undef;
 352   }
 353
 354   my $range_padding = $self->_get_number('range_padding');
 355   if (defined $config_min) {
 356     $min_value = $config_min;
 357   }
 358   else {
 359     if ($min_value > 0) {
 360       $min_value = 0;
 361     }
 362     if ($range_padding && $min_value < 0) {
 363       my $difference = $min_value * $range_padding / 100;
 364       if ($min_value < -1 && $difference > -1) {
 365         $difference = -1;
 366       }
 367       $min_value += $difference;
 368     }
 369   }
 370   if (defined $config_max) {
 371     $max_value = $config_max;
 372   }
 373   else {
 374     if ($range_padding && $max_value > 0) {
 375       my $difference = $max_value * $range_padding / 100;
 376       if ($max_value > 1 && $difference < 1) {
 377         $difference = 1;
 378       }
 379       $max_value += $difference;
 380     }
 381   }
 382   $column_count = $self->_max(0, $sc_cols, $l_cols, $a_cols);
 383
 384   if ($self->_get_number('automatic_axis')) {
 385     # In case this was set via a style, and not by the api method
 386     eval { require Chart::Math::Axis; };
 387     if ($@) {
 388       return $self->_error("Can't use automatic_axis - $@");
 389     }
 390
 391     my $axis = Chart::Math::Axis->new();
 392     $axis->include_zero();
 393     $axis->add_data($min_value, $max_value);
 394     $max_value = $axis->top;
 395     $min_value = $axis->bottom;
 396     my $ticks     = $axis->ticks;
 397     # The +1 is there because we have the bottom tick as well
 398     $self->set_y_tics($ticks+1);
 399   }
 400
 401   $self->_set_max_value($max_value);
 402   $self->_set_min_value($min_value);
 403   $self->_set_column_count($column_count);
 404
 405   return 1;
 406 }
 407
 408 sub _min {
 409   my $self = shift;
 410   my $min = shift;
 411
 412   foreach my $value (@_) {
 413     next unless defined $value;
 414     if ($value < $min) { $min = $value; }
 415   }
 416   return $min;
 417 }
 418
 419 sub _max {
 420   my $self = shift;
 421   my $min = shift;
 422
 423   foreach my $value (@_) {
 424     next unless defined $value;
 425     if ($value > $min) { $min = $value; }
 426   }
 427   return $min;
 428 }
 429
 430 sub _get_line_range {
 431   my $self = shift;
 432   my $series = $self->_get_data_series()->{'line'};
 433   return (undef, undef, 0) unless $series;
 434
 435   my $max_value = 0;
 436   my $min_value = STARTING_MIN_VALUE;
 437   my $column_count = 0;
 438
 439   my @series = @{$series};
 440   foreach my $series (@series) {
 441     my @data = @{$series->{'data'}};
 442
 443     if (scalar @data > $column_count) {
 444       $column_count = scalar @data;
 445     }
 446
 447     foreach my $value (@data) {
 448       if ($value > $max_value) { $max_value = $value; }
 449       if ($value < $min_value) { $min_value = $value; }
 450     }
 451   }
 452
 453   return ($min_value, $max_value, $column_count);
 454 }
 455
 456 sub _get_area_range {
 457   my $self = shift;
 458   my $series = $self->_get_data_series()->{'area'};
 459   return (undef, undef, 0) unless $series;
 460
 461   my $max_value = 0;
 462   my $min_value = STARTING_MIN_VALUE;
 463   my $column_count = 0;
 464
 465   my @series = @{$series};
 466   foreach my $series (@series) {
 467     my @data = @{$series->{'data'}};
 468
 469     if (scalar @data > $column_count) {
 470       $column_count = scalar @data;
 471     }
 472
 473     foreach my $value (@data) {
 474       if ($value > $max_value) { $max_value = $value; }
 475       if ($value < $min_value) { $min_value = $value; }
 476     }
 477   }
 478
 479   return ($min_value, $max_value, $column_count);
 480 }
 481
 482
 483 sub _get_column_range {
 484   my $self = shift;
 485
 486   my $series = $self->_get_data_series()->{'column'};
 487   return (undef, undef, 0) unless $series;
 488
 489   my $max_value = 0;
 490   my $min_value = STARTING_MIN_VALUE;
 491   my $column_count = 0;
 492
 493   my @series = @{$series};
 494   foreach my $series (@series) {
 495     my @data = @{$series->{'data'}};
 496
 497     foreach my $value (@data) {
 498       $column_count++;
 499       if ($value > $max_value) { $max_value = $value; }
 500       if ($value < $min_value) { $min_value = $value; }
 501     }
 502   }
 503
 504   return ($min_value, $max_value, $column_count);
 505 }
 506
 507 sub _get_stacked_column_range {
 508   my $self = shift;
 509
 510   my $max_value = 0;
 511   my $min_value = STARTING_MIN_VALUE;
 512   my $column_count = 0;
 513
 514   return (undef, undef, 0) unless $self->_get_data_series()->{'stacked_column'};
 515   my @series = @{$self->_get_data_series()->{'stacked_column'}};
 516
 517   my @max_entries;
 518   my @min_entries;
 519   for (my $i = scalar @series - 1; $i >= 0; $i--) {
 520     my $series = $series[$i];
 521     my $data = $series->{'data'};
 522
 523     for (my $i = 0; $i < scalar @$data; $i++) {
 524       my $value = 0;
 525       if ($data->[$i] > 0) {
 526         $value = $data->[$i] + ($max_entries[$i] || 0);
 527         $data->[$i] = $value;
 528         $max_entries[$i] = $value;
 529       }
 530       elsif ($data->[$i] < 0) {
 531         $value = $data->[$i] + ($min_entries[$i] || 0);
 532         $data->[$i] = $value;
 533         $min_entries[$i] = $value;
 534       }
 535       if ($value > $max_value) { $max_value = $value; }
 536       if ($value < $min_value) { $min_value = $value; }
 537     }
 538     if (scalar @$data > $column_count) {
 539       $column_count = scalar @$data;
 540     }
 541   }
 542
 543   return ($min_value, $max_value, $column_count);
 544 }
 545
 546 sub _draw_legend {
 547   my $self = shift;
 548   my $chart_box = shift;
 549   my $style = $self->{'_style'};
 550
 551   my @labels;
 552   my $img = $self->_get_image();
 553   if (my $series = $self->_get_data_series()->{'stacked_column'}) {
 554     push @labels, map { $_->{'series_name'} } @$series;
 555   }
 556   if (my $series = $self->_get_data_series()->{'column'}) {
 557     push @labels, map { $_->{'series_name'} } @$series;
 558   }
 559   if (my $series = $self->_get_data_series()->{'line'}) {
 560     push @labels, map { $_->{'series_name'} } @$series;
 561   }
 562   if (my $series = $self->_get_data_series()->{'area'}) {
 563     push @labels, map { $_->{'series_name'} } @$series;
 564   }
 565
 566   if ($style->{features}{legend} && (scalar @labels)) {
 567     $self->SUPER::_draw_legend($self->_get_image(), \@labels, $chart_box)
 568       or return;
 569   }
 570   return;
 571 }
 572
 573 sub _draw_flat_legend {
 574   return 1;
 575 }
 576
 577 sub _draw_lines {
 578   my $self = shift;
 579   my $style = $self->{'_style'};
 580
 581   my $img = $self->_get_image();
 582
 583   my $max_value = $self->_get_max_value();
 584   my $min_value = $self->_get_min_value();
 585   my $column_count = $self->_get_column_count();
 586
 587   my $value_range = $max_value - $min_value;
 588
 589   my $width = $self->_get_number('width');
 590   my $height = $self->_get_number('height');
 591
 592   my $graph_width = $self->_get_number('graph_width');
 593   my $graph_height = $self->_get_number('graph_height');
 594
 595   my $line_series = $self->_get_data_series()->{'line'};
 596   my $series_counter = $self->_get_series_counter() || 0;
 597
 598   my $has_columns = (defined $self->_get_data_series()->{'column'} || $self->_get_data_series->{'stacked_column'}) ? 1 : 0;
 599
 600   my $col_width = int($graph_width / $column_count) -1;
 601
 602   my $graph_box = $self->_get_graph_box();
 603   my $left = $graph_box->[0] + 1;
 604   my $bottom = $graph_box->[1];
 605
 606   my $zero_position =  $bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height - 1);
 607
 608   my $line_aa = $self->_get_number("lineaa");
 609   foreach my $series (@$line_series) {
 610     my @data = @{$series->{'data'}};
 611     my $data_size = scalar @data;
 612
 613     my $interval;
 614     if ($has_columns) {
 615       $interval = $graph_width / ($data_size);
 616     }
 617     else {
 618       $interval = $graph_width / ($data_size - 1);
 619     }
 620     my $color = $self->_data_color($series_counter);
 621
 622     # We need to add these last, otherwise the next line segment will overwrite half of the marker
 623     my @marker_positions;
 624     for (my $i = 0; $i < $data_size - 1; $i++) {
 625       my $x1 = $left + $i * $interval;
 626       my $x2 = $left + ($i + 1) * $interval;
 627
 628       $x1 += $has_columns * $interval / 2;
 629       $x2 += $has_columns * $interval / 2;
 630
 631       my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height;
 632       my $y2 = $bottom + ($value_range - $data[$i + 1] + $min_value)/$value_range * $graph_height;
 633
 634       push @marker_positions, [$x1, $y1];
 635       $img->line(x1 => $x1, y1 => $y1, x2 => $x2, y2 => $y2, aa => $line_aa, color => $color) || die $img->errstr;
 636     }
 637
 638     my $x2 = $left + ($data_size - 1) * $interval;
 639     $x2 += $has_columns * $interval / 2;
 640
 641     my $y2 = $bottom + ($value_range - $data[$data_size - 1] + $min_value)/$value_range * $graph_height;
 642
 643     if ($self->_feature_enabled("linemarkers")) {
 644       push @marker_positions, [$x2, $y2];
 645       foreach my $position (@marker_positions) {
 646         $self->_draw_line_marker($position->[0], $position->[1], $series_counter);
 647       }
 648     }
 649     $series_counter++;
 650   }
 651
 652   $self->_set_series_counter($series_counter);
 653   return 1;
 654 }
 655
 656 sub _area_data_fill {
 657   my ($self, $index, $box) = @_;
 658
 659   my %fill = $self->_data_fill($index, $box);
 660
 661   my $opacity = $self->_get_number("area.opacity");
 662   $opacity == 1
 663     and return %fill;
 664
 665   my $orig_fill = $fill{fill};
 666   unless ($orig_fill) {
 667     $orig_fill = Imager::Fill->new
 668       (
 669        solid => $fill{color},
 670        combine => "normal",
 671       );
 672   }
 673   return
 674     (
 675      fill => Imager::Fill->new
 676      (
 677       type => "opacity",
 678       other => $orig_fill,
 679       opacity => $opacity,
 680      ),
 681     );
 682 }
 683
 684 sub _draw_area {
 685   my $self = shift;
 686   my $style = $self->{'_style'};
 687
 688   my $img = $self->_get_image();
 689
 690   my $max_value = $self->_get_max_value();
 691   my $min_value = $self->_get_min_value();
 692   my $column_count = $self->_get_column_count();
 693
 694   my $value_range = $max_value - $min_value;
 695
 696   my $width = $self->_get_number('width');
 697   my $height = $self->_get_number('height');
 698
 699   my $graph_width = $self->_get_number('graph_width');
 700   my $graph_height = $self->_get_number('graph_height');
 701
 702   my $area_series = $self->_get_data_series()->{'area'};
 703   my $series_counter = $self->_get_series_counter() || 0;
 704
 705   my $col_width = int($graph_width / $column_count) -1;
 706
 707   my $graph_box = $self->_get_graph_box();
 708   my $left = $graph_box->[0] + 1;
 709   my $bottom = $graph_box->[1];
 710   my $right = $graph_box->[2];
 711   my $top = $graph_box->[3];
 712
 713   my $zero_position =  $bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height - 1);
 714
 715   my $line_aa = $self->_get_number("lineaa");
 716   foreach my $series (@$area_series) {
 717     my @data = @{$series->{'data'}};
 718     my $data_size = scalar @data;
 719
 720     my $interval = $graph_width / ($data_size - 1);
 721
 722     my $color = $self->_data_color($series_counter);
 723
 724     # We need to add these last, otherwise the next line segment will overwrite half of the marker
 725     my @marker_positions;
 726     my @polygon_points;
 727     for (my $i = 0; $i < $data_size - 1; $i++) {
 728       my $x1 = $left + $i * $interval;
 729
 730       my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height;
 731
 732       if ($i == 0) {
 733         push @polygon_points, [$x1, $top];
 734       }
 735       push @polygon_points, [$x1, $y1];
 736
 737       push @marker_positions, [$x1, $y1];
 738     }
 739
 740     my $x2 = $left + ($data_size - 1) * $interval;
 741
 742     my $y2 = $bottom + ($value_range - $data[$data_size - 1] + $min_value)/$value_range * $graph_height;
 743     push @polygon_points, [$x2, $y2];
 744     push @polygon_points, [$x2, $top];
 745     push @polygon_points, $polygon_points[0];
 746
 747     my @fill = $self->_area_data_fill($series_counter, [$left, $bottom, $right, $top]);
 748     $img->polygon(points => [@polygon_points], @fill);
 749
 750     if ($self->_feature_enabled("areamarkers")) {
 751       push @marker_positions, [$x2, $y2];
 752       foreach my $position (@marker_positions) {
 753         $self->_draw_line_marker($position->[0], $position->[1], $series_counter);
 754       }
 755     }
 756     $series_counter++;
 757   }
 758
 759   $self->_set_series_counter($series_counter);
 760   return 1;
 761 }
 762
 763 sub _draw_columns {
 764   my $self = shift;
 765   my $style = $self->{'_style'};
 766
 767   my $img = $self->_get_image();
 768
 769   my $max_value = $self->_get_max_value();
 770   my $min_value = $self->_get_min_value();
 771   my $column_count = $self->_get_column_count();
 772
 773   my $value_range = $max_value - $min_value;
 774
 775   my $width = $self->_get_number('width');
 776   my $height = $self->_get_number('height');
 777
 778   my $graph_width = $self->_get_number('graph_width');
 779   my $graph_height = $self->_get_number('graph_height');
 780
 781
 782   my $graph_box = $self->_get_graph_box();
 783   my $left = $graph_box->[0] + 1;
 784   my $bottom = $graph_box->[1];
 785   my $zero_position =  int($bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height -1));
 786
 787   my $bar_width = $graph_width / $column_count;
 788
 789   my $outline_color;
 790   if ($style->{'features'}{'outline'}) {
 791     $outline_color = $self->_get_color('outline.line');
 792   }
 793
 794   my $series_counter = $self->_get_series_counter() || 0;
 795   my $col_series = $self->_get_data_series()->{'column'};
 796   my $column_padding_percent = $self->_get_number('column_padding') || 0;
 797   my $column_padding = int($column_padding_percent * $bar_width / 100);
 798
 799   # This tracks the series we're in relative to the starting series - this way colors stay accurate, but the columns don't start out too far to the right.
 800   my $column_series = 0;
 801
 802   # If there are stacked columns, non-stacked columns need to start one to the right of where they would otherwise
 803   my $has_stacked_columns = (defined $self->_get_data_series()->{'stacked_column'} ? 1 : 0);
 804
 805   for (my $series_pos = 0; $series_pos < scalar @$col_series; $series_pos++) {
 806     my $series = $col_series->[$series_pos];
 807     my @data = @{$series->{'data'}};
 808     my $data_size = scalar @data;
 809     for (my $i = 0; $i < $data_size; $i++) {
 810       my $part1 = $bar_width * (scalar @$col_series * $i);
 811       my $part2 = ($series_pos) * $bar_width;
 812       my $x1 = $left + $part1 + $part2;
 813       if ($has_stacked_columns) {
 814         $x1 += ($bar_width * ($i+1));
 815       }
 816       $x1 = int($x1);
 817
 818       my $x2 = int($x1 + $bar_width - $column_padding)-1;
 819       # Special case for when bar_width is less than 1.
 820       if ($x2 < $x1) {
 821         $x2 = $x1;
 822       }
 823
 824       my $y1 = int($bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height);
 825
 826       my $color = $self->_data_color($series_counter);
 827
 828       if ($data[$i] > 0) {
 829         my @fill = $self->_data_fill($series_counter, [$x1, $y1, $x2, $zero_position-1]);
 830         $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, @fill);
 831         if ($style->{'features'}{'outline'}) {
 832           $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color);
 833         }
 834       }
 835       else {
 836         my @fill = $self->_data_fill($series_counter, [$x1, $zero_position+1, $x2, $y1]);
 837         $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1, @fill);
 838         if ($style->{'features'}{'outline'}) {
 839           $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1+1, color => $outline_color);
 840         }
 841       }
 842     }
 843
 844     $series_counter++;
 845     $column_series++;
 846   }
 847   $self->_set_series_counter($series_counter);
 848   return 1;
 849 }
 850
 851 sub _draw_stacked_columns {
 852   my $self = shift;
 853   my $style = $self->{'_style'};
 854
 855   my $img = $self->_get_image();
 856
 857   my $max_value = $self->_get_max_value();
 858   my $min_value = $self->_get_min_value();
 859   my $column_count = $self->_get_column_count();
 860   my $value_range = $max_value - $min_value;
 861
 862   my $graph_box = $self->_get_graph_box();
 863   my $left = $graph_box->[0] + 1;
 864   my $bottom = $graph_box->[1];
 865
 866   my $graph_width = $self->_get_number('graph_width');
 867   my $graph_height = $self->_get_number('graph_height');
 868
 869   my $bar_width = $graph_width / $column_count;
 870   my $column_series = 0;
 871   if (my $column_series_data = $self->_get_data_series()->{'column'}) {
 872     $column_series = (scalar @$column_series_data);
 873   }
 874   $column_series++;
 875
 876   my $column_padding_percent = $self->_get_number('column_padding') || 0;
 877   if ($column_padding_percent < 0) {
 878     return $self->_error("Column padding less than 0");
 879   }
 880   if ($column_padding_percent > 100) {
 881     return $self->_error("Column padding greater than 0");
 882   }
 883   my $column_padding = int($column_padding_percent * $bar_width / 100);
 884
 885   my $outline_color;
 886   if ($style->{'features'}{'outline'}) {
 887     $outline_color = $self->_get_color('outline.line');
 888   }
 889
 890   my $zero_position =  $bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height -1);
 891   my $col_series = $self->_get_data_series()->{'stacked_column'};
 892   my $series_counter = $self->_get_series_counter() || 0;
 893
 894   foreach my $series (@$col_series) {
 895     my @data = @{$series->{'data'}};
 896     my $data_size = scalar @data;
 897     for (my $i = 0; $i < $data_size; $i++) {
 898       my $part1 = $bar_width * $i * $column_series;
 899       my $part2 = 0;
 900       my $x1 = int($left + $part1 + $part2);
 901       my $x2 = int($x1 + $bar_width - $column_padding) - 1;
 902       # Special case for when bar_width is less than 1.
 903       if ($x2 < $x1) {
 904         $x2 = $x1;
 905       }
 906
 907       my $y1 = int($bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height);
 908
 909       if ($data[$i] > 0) {
 910         my @fill = $self->_data_fill($series_counter, [$x1, $y1, $x2, $zero_position-1]);
 911         $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, @fill);
 912         if ($style->{'features'}{'outline'}) {
 913           $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color);
 914         }
 915       }
 916       else {
 917         my @fill = $self->_data_fill($series_counter, [$x1, $zero_position+1, $x2, $y1]);
 918         $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1, @fill);
 919         if ($style->{'features'}{'outline'}) {
 920           $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1+1, color => $outline_color);
 921         }
 922       }
 923     }
 924
 925     $series_counter++;
 926   }
 927   $self->_set_series_counter($series_counter);
 928   return 1;
 929 }
 930
 931 sub _add_data_series {
 932   my $self = shift;
 933   my $series_type = shift;
 934   my $data_ref = shift;
 935   my $series_name = shift;
 936
 937   my $graph_data = $self->{'graph_data'} || {};
 938
 939   my $series = $graph_data->{$series_type} || [];
 940
 941   push @$series, { data => $data_ref, series_name => $series_name };
 942
 943   $graph_data->{$series_type} = $series;
 944
 945   $self->{'graph_data'} = $graph_data;
 946   return;
 947 }
 948
 949 =back
 950
 951 =head1 FEATURES
 952
 953 =over
 954
 955 =item show_horizontal_gridlines()
 956
 957 Feature: horizontal_gridlines
 958 X<horizontal_gridlines>X<features, horizontal_gridlines>
 959
 960 Enables the C<horizontal_gridlines> feature, which shows horizontal
 961 gridlines at the y-tics.
 962
 963 The style of the gridlines can be controlled with the
 964 set_horizontal_gridline_style() method (or by setting the hgrid
 965 style).
 966
 967 =cut
 968
 969 sub show_horizontal_gridlines {
 970     $_[0]->{'custom_style'}{features}{'horizontal_gridlines'} = 1;
 971 }
 972
 973 =item set_horizontal_gridline_style(style => $style, color => $color)
 974
 975 Style: hgrid.
 976 X<hgrid>X<style parameters, hgrid>
 977
 978 Set the style and color of horizonal gridlines.
 979
 980 See: L<Imager::Graph/"Line styles">
 981
 982 =cut
 983
 984 sub set_horizontal_gridline_style {
 985   my ($self, %opts) = @_;
 986
 987   $self->{custom_style}{hgrid} ||= {};
 988   @{$self->{custom_style}{hgrid}}{keys %opts} = values %opts;
 989
 990   return 1;
 991 }
 992
 993 =item show_graph_outline($flag)
 994
 995 Feature: graph_outline
 996 X<graph_outline>X<features, graph_outline>
 997
 998 If no flag is supplied, unconditionally enable the graph outline.
 999
1000 If $flag is supplied, enable/disable the graph_outline feature based
1001 on that.
1002
1003 Enabled by default.
1004
1005 =cut
1006
1007 sub show_graph_outline {
1008   my ($self, $flag) = @_;
1009
1010   @_ == 1 and $flag = 1;
1011
1012   $self->{custom_style}{features}{graph_outline} = $flag;
1013
1014   return 1;
1015 }
1016
1017 =item set_graph_outline_style(color => ...)
1018
1019 =item set_graph_outline_style(style => ..., color => ...)
1020
1021 Style: graph.outline
1022 X<graph.outline>X<style parameters, graph.outline>
1023
1024 Sets the style of the graph outline.
1025
1026 Default: the style C<fg>.
1027
1028 =cut
1029
1030 sub set_graph_outline_style {
1031   my ($self, %opts) = @_;
1032
1033   $self->{custom_style}{graph}{outline} = \%opts;
1034
1035   return 1;
1036 }
1037
1038 =item set_graph_fill_style(I<fill parameters>)
1039
1040 Style: graph.fill
1041 X<graph.fill>X<style parameters, graph.fill>
1042
1043 Set the fill used to fill the graph data area.
1044
1045 Default: the style C<bg>.
1046
1047 eg.
1048
1049   $graph->set_graph_fill_style(solid => "FF000020", combine => "normal");
1050
1051 =cut
1052
1053 sub set_graph_fill_style {
1054   my ($self, %opts) = @_;
1055
1056   $self->{custom_style}{graph}{fill} = \%opts;
1057
1058   return 1;
1059 }
1060
1061 =item show_area_markers()
1062
1063 =item show_area_markers($value)
1064
1065 Feature: areamarkers.
1066
1067 If $value is missing or true, draw markers along the top of area data
1068 series.
1069
1070 eg.
1071
1072   $chart->show_area_markers();
1073
1074 =cut
1075
1076 sub show_area_markers {
1077   my ($self, $value) = @_;
1078
1079   @_ > 1 or $value = 1;
1080
1081   $self->{custom_style}{features}{areamarkers} = $value;
1082
1083   return 1;
1084 }
1085
1086 =item show_line_markers()
1087
1088 =item show_line_markers($value)
1089
1090 Feature: linemarkers.
1091
1092 If $value is missing or true, draw markers on a line data series.
1093
1094 Note: line markers are drawn by default.
1095
1096 =cut
1097
1098 sub show_line_markers {
1099   my ($self, $value) = @_;
1100
1101   @_ > 1 or $value = 1;
1102
1103   $self->{custom_style}{features}{linemarkers} = $value;
1104
1105   return 1;
1106 }
1107
1108 =item use_automatic_axis()
1109
1110 Automatically scale the Y axis, based on L<Chart::Math::Axis>.  If
1111 Chart::Math::Axis isn't installed, this sets an error and returns
1112 undef.  Returns 1 if it is installed.
1113
1114 =cut
1115
1116 sub use_automatic_axis {
1117   eval { require Chart::Math::Axis; };
1118   if ($@) {
1119     return $_[0]->_error("use_automatic_axis - $@\nCalled from ".join(' ', caller)."\n");
1120   }
1121   $_[0]->{'custom_style'}->{'automatic_axis'} = 1;
1122   return 1;
1123 }
1124
1125 =item set_y_tics($count)
1126
1127 Set the number of Y tics to use.  Their value and position will be
1128 determined by the data range.
1129
1130 =cut
1131
1132 sub set_y_tics {
1133   $_[0]->{'y_tics'} = $_[1];
1134 }
1135
1136 sub _get_y_tics {
1137   return $_[0]->{'y_tics'} || 0;
1138 }
1139
1140 sub _remove_tics_from_chart_box {
1141   my ($self, $chart_box, $opts) = @_;
1142
1143   # XXX - bad default
1144   my $tic_width = $self->_get_y_tic_width() || 10;
1145   my @y_tic_box = ($chart_box->[0], $chart_box->[1], $chart_box->[0] + $tic_width, $chart_box->[3]);
1146
1147   # XXX - bad default
1148   my $tic_height = $self->_get_x_tic_height($opts) || 10;
1149   my @x_tic_box = ($chart_box->[0], $chart_box->[3] - $tic_height, $chart_box->[2], $chart_box->[3]);
1150
1151   $self->_remove_box($chart_box, \@y_tic_box);
1152   $self->_remove_box($chart_box, \@x_tic_box);
1153
1154   # If there's no title, the y-tics will be part off-screen.  Half of the x-tic height should be more than sufficient.
1155   my @y_tic_tops = ($chart_box->[0], $chart_box->[1], $chart_box->[2], $chart_box->[1] + int($tic_height / 2));
1156   $self->_remove_box($chart_box, \@y_tic_tops);
1157
1158   # Make sure that the first and last label fit
1159   if (my $labels = $self->_get_labels($opts)) {
1160     if (my @box = $self->_text_bbox($labels->[0], 'legend')) {
1161       my @remove_box = ($chart_box->[0],
1162                         $chart_box->[1],
1163                         $chart_box->[0] + int($box[2] / 2) + 1,
1164                         $chart_box->[3]
1165                         );
1166
1167       $self->_remove_box($chart_box, \@remove_box);
1168     }
1169     if (my @box = $self->_text_bbox($labels->[-1], 'legend')) {
1170       my @remove_box = ($chart_box->[2] - int($box[2] / 2) - 1,
1171                         $chart_box->[1],
1172                         $chart_box->[2],
1173                         $chart_box->[3]
1174                         );
1175
1176       $self->_remove_box($chart_box, \@remove_box);
1177     }
1178   }
1179 }
1180
1181 sub _get_y_tic_width {
1182   my $self = shift;
1183   my $min = $self->_get_min_value();
1184   my $max = $self->_get_max_value();
1185   my $tic_count = $self->_get_y_tics();
1186
1187   my $interval = ($max - $min) / ($tic_count - 1);
1188
1189   my %text_info = $self->_text_style('legend')
1190     or return;
1191
1192   my $max_width = 0;
1193   for my $count (0 .. $tic_count - 1) {
1194     my $value = ($count*$interval)+$min;
1195
1196     if ($interval < 1 || ($value != int($value))) {
1197       $value = sprintf("%.2f", $value);
1198     }
1199     my @box = $self->_text_bbox($value, 'legend');
1200     my $width = $box[2] - $box[0];
1201
1202     # For the tic width
1203     $width += 10;
1204     if ($width > $max_width) {
1205       $max_width = $width;
1206     }
1207   }
1208
1209   return $max_width;
1210 }
1211
1212 sub _get_x_tic_height {
1213   my ($self, $opts) = @_;
1214
1215   my $labels = $self->_get_labels($opts);
1216
1217   if (!$labels) {
1218         return;
1219   }
1220
1221   my $tic_count = (scalar @$labels) - 1;
1222
1223   my %text_info = $self->_text_style('legend')
1224     or return;
1225
1226   my $max_height = 0;
1227   for my $count (0 .. $tic_count) {
1228     my $label = $labels->[$count];
1229
1230     my @box = $self->_text_bbox($label, 'legend');
1231
1232     my $height = $box[3] - $box[1];
1233
1234     # Padding + the tic
1235     $height += 10;
1236     if ($height > $max_height) {
1237       $max_height = $height;
1238     }
1239   }
1240
1241   return $max_height;
1242 }
1243
1244 sub _draw_y_tics {
1245   my $self = shift;
1246   my $min = $self->_get_min_value();
1247   my $max = $self->_get_max_value();
1248   my $tic_count = $self->_get_y_tics();
1249
1250   my $img = $self->_get_image();
1251   my $graph_box = $self->_get_graph_box();
1252   my $image_box = $self->_get_image_box();
1253
1254   my $interval = ($max - $min) / ($tic_count - 1);
1255
1256   my %text_info = $self->_text_style('legend')
1257     or return;
1258
1259   my $line_style = $self->_get_color('outline.line');
1260   my $show_gridlines = $self->{_style}{features}{'horizontal_gridlines'};
1261   my @grid_line = $self->_get_line("hgrid");
1262   my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($tic_count - 1);
1263   for my $count (0 .. $tic_count - 1) {
1264     my $x1 = $graph_box->[0] - 5;
1265     my $x2 = $graph_box->[0] + 5;
1266     my $y1 = int($graph_box->[3] - ($count * $tic_distance));
1267
1268     my $value = ($count*$interval)+$min;
1269     if ($interval < 1 || ($value != int($value))) {
1270         $value = sprintf("%.2f", $value);
1271     }
1272
1273     my @box = $self->_text_bbox($value, 'legend')
1274       or return;
1275
1276     $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => $line_style);
1277
1278     my $width = $box[2];
1279     my $height = $box[3];
1280
1281     $img->string(%text_info,
1282                  x    => ($x1 - $width - 3),
1283                  y    => ($y1 + ($height / 2)),
1284                  text => $value
1285                 );
1286
1287     if ($show_gridlines && $y1 != $graph_box->[1] && $y1 != $graph_box->[3]) {
1288       $self->_line(x1 => $graph_box->[0], y1 => $y1,
1289                    x2 => $graph_box->[2], y2 => $y1,
1290                    img => $img,
1291                    @grid_line);
1292     }
1293   }
1294
1295 }
1296
1297 sub _draw_x_tics {
1298   my ($self, $opts) = @_;
1299
1300   my $img = $self->_get_image();
1301   my $graph_box = $self->_get_graph_box();
1302   my $image_box = $self->_get_image_box();
1303
1304   my $labels = $self->_get_labels($opts);
1305
1306   my $tic_count = (scalar @$labels) - 1;
1307
1308   my $has_columns = (defined $self->_get_data_series()->{'column'} || defined $self->_get_data_series()->{'stacked_column'});
1309
1310   # If we have columns, we want the x-ticks to show up in the middle of the column, not on the left edge
1311   my $denominator = $tic_count;
1312   if ($has_columns) {
1313     $denominator ++;
1314   }
1315   my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($denominator);
1316   my %text_info = $self->_text_style('legend')
1317     or return;
1318
1319   # If automatic axis is turned on, let's be selective about what labels we draw.
1320   my $max_size = 0;
1321   my $tic_skip = 0;
1322   if ($self->_get_number('automatic_axis')) {
1323     foreach my $label (@$labels) {
1324       my @box = $self->_text_bbox($label, 'legend');
1325       if ($box[2] > $max_size) {
1326         $max_size = $box[2];
1327       }
1328     }
1329
1330     # Give the max_size some padding...
1331     $max_size *= 1.2;
1332
1333     $tic_skip = int($max_size / $tic_distance) + 1;
1334   }
1335
1336   my $line_style = $self->_get_color('outline.line');
1337
1338   for my $count (0 .. $tic_count) {
1339     next if ($count % ($tic_skip + 1));
1340     my $label = $labels->[$count];
1341     my $x1 = $graph_box->[0] + ($tic_distance * $count);
1342
1343     if ($has_columns) {
1344       $x1 += $tic_distance / 2;
1345     }
1346
1347     $x1 = int($x1);
1348
1349     my $y1 = $graph_box->[3] + 5;
1350     my $y2 = $graph_box->[3] - 5;
1351
1352     $img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => $line_style);
1353
1354     my @box = $self->_text_bbox($label, 'legend')
1355       or return;
1356
1357     my $width = $box[2];
1358     my $height = $box[3];
1359
1360     $img->string(%text_info,
1361                  x    => ($x1 - ($width / 2)),
1362                  y    => ($y1 + ($height + 5)),
1363                  text => $label
1364                 );
1365
1366   }
1367 }
1368
1369 sub _valid_input {
1370   my $self = shift;
1371
1372   if (!defined $self->_get_data_series() || !keys %{$self->_get_data_series()}) {
1373     return $self->_error("No data supplied");
1374   }
1375
1376   my $data = $self->_get_data_series();
1377   if (defined $data->{'line'} && !scalar @{$data->{'line'}->[0]->{'data'}}) {
1378     return $self->_error("No values in data series");
1379   }
1380   if (defined $data->{'column'} && !scalar @{$data->{'column'}->[0]->{'data'}}) {
1381     return $self->_error("No values in data series");
1382   }
1383   if (defined $data->{'stacked_column'} && !scalar @{$data->{'stacked_column'}->[0]->{'data'}}) {
1384     return $self->_error("No values in data series");
1385   }
1386
1387   return 1;
1388 }
1389
1390 sub _set_column_count   { $_[0]->{'column_count'} = $_[1]; }
1391 sub _set_min_value      { $_[0]->{'min_value'} = $_[1]; }
1392 sub _set_max_value      { $_[0]->{'max_value'} = $_[1]; }
1393 sub _set_image_box      { $_[0]->{'image_box'} = $_[1]; }
1394 sub _set_graph_box      { $_[0]->{'graph_box'} = $_[1]; }
1395 sub _set_series_counter { $_[0]->{'series_counter'} = $_[1]; }
1396 sub _get_column_count   { return $_[0]->{'column_count'} }
1397 sub _get_min_value      { return $_[0]->{'min_value'} }
1398 sub _get_max_value      { return $_[0]->{'max_value'} }
1399 sub _get_image_box      { return $_[0]->{'image_box'} }
1400 sub _get_graph_box      { return $_[0]->{'graph_box'} }
1401 sub _reset_series_counter { $_[0]->{series_counter} = 0 }
1402 sub _get_series_counter { return $_[0]->{'series_counter'} }
1403
1404 sub _style_defs {
1405   my ($self) = @_;
1406
1407   my %work = %{$self->SUPER::_style_defs()};
1408   $work{area} =
1409     {
1410      opacity => 0.5,
1411     };
1412   push @{$work{features}}, qw/graph_outline graph_fill linemarkers/;
1413   $work{hgrid} =
1414     {
1415      color => "lookup(fg)",
1416      style => "solid",
1417     };
1418
1419   return \%work;
1420 }
1421
1422 sub _composite {
1423   my ($self) = @_;
1424   return ( $self->SUPER::_composite(), "graph", "hgrid" );
1425 }
1426
1427 1;