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