lib/Imager/Graph/Line.pm

   1 package Imager::Graph::Line;
   2
   3 =head1 NAME
   4
   5   Imager::Graph::Line - a tool for drawing line charts on Imager images
   6
   7 =head1 SYNOPSIS
   8
   9   This subclass is still in green development.
  10
  11 =cut
  12
  13 use strict;
  14 use vars qw(@ISA);
  15 use Imager::Graph;
  16 @ISA = qw(Imager::Graph);
  17
  18 =item setYTics($count)
  19
  20 Set the number of Y tics to use.  Their value and position will be determined by the data range.
  21
  22 =cut
  23
  24 sub setYTics {
  25   $_[0]->{'y_tics'} = $_[1];
  26 }
  27
  28 sub _getYTics {
  29   return $_[0]->{'y_tics'};
  30 }
  31
  32 sub draw {
  33   my ($self, %opts) = @_;
  34
  35   $self->_processOptions(\%opts);
  36
  37   if (!$self->_validInput()) {
  38     return;
  39   }
  40
  41   $self->_style_setup(\%opts);
  42
  43   my $style = $self->{_style};
  44
  45   my $img = $self->_make_img()
  46     or return;
  47
  48   my @chart_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
  49
  50   my @labels = map { $_->{'series_name'} } @{$self->_getDataSeries()};
  51   if ($style->{features}{legend} && (scalar @labels)) {
  52     $self->_draw_legend($img, \@labels, \@chart_box)
  53       or return;
  54   }
  55
  56   my @series = @{$self->_getDataSeries()};
  57   my $max_value = 0;
  58   my $min_value = 0;
  59
  60   foreach my $series (@series) {
  61     my @data = @{$series->{'data'}};
  62
  63     foreach my $value (@data) {
  64       if ($value > $max_value) { $max_value = $value; }
  65       if ($value < $min_value) { $min_value = $value; }
  66     }
  67   }
  68
  69   my $value_range = $max_value - $min_value;
  70
  71   my $width = $self->_get_number('width');
  72   my $height = $self->_get_number('height');
  73   my $size = $self->_get_number('size');
  74
  75   my $bottom = ($height - $size) / 2;
  76   my $left   = ($width - $size) / 2;
  77
  78   my @graph_box = ( $left, $bottom, $left + $size - 1, $bottom + $size - 1 );
  79
  80   $img->box(
  81             color   => '000000',
  82             xmin    => $left,
  83             xmax    => $left+$size,
  84             ymin    => $bottom,
  85             ymax    => $bottom+$size,
  86             );
  87
  88   $img->box(
  89             color   => 'FFFFFF',
  90             xmin    => $left + 1,
  91             xmax    => $left+$size - 1,
  92             ymin    => $bottom + 1,
  93             ymax    => $bottom+$size -1 ,
  94             filled  => 1,
  95             );
  96
  97   if ($min_value < 0) {
  98     $img->box(
  99             color   => 'EEEEEE',
 100             xmin    => $left + 1,
 101             xmax    => $left+$size - 1,
 102             ymin    => $bottom + $size - (-1*$min_value / $value_range) * ($size -1),
 103             ymax    => $bottom+$size -1,
 104             filled  => 1,
 105     );
 106   }
 107
 108   if ($self->_getYTics()) {
 109     $self->_drawYTics($img, $min_value, $max_value, $self->_getYTics(), \@graph_box, \@chart_box);
 110   }
 111   if ($self->_getLabels()) {
 112     $self->_drawXTics($img, \@graph_box, \@chart_box);
 113   }
 114
 115   my $series_counter = 0;
 116   foreach my $series (@series) {
 117     my @data = @{$series->{'data'}};
 118     my $data_size = scalar @data;
 119     my @fill = $self->_data_fill($series_counter, \@graph_box);
 120     my $color = $self->_data_color($series_counter);
 121     for (my $i = 0; $i < $data_size - 1; $i++) {
 122       my $x1 = $left + $i * $size / ($data_size - 1);
 123       my $x2 = $left + ($i + 1) * $size / ($data_size - 1);
 124
 125       my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $size;
 126       my $y2 = $bottom + ($value_range - $data[$i + 1] + $min_value)/$value_range * $size;
 127
 128       $img->line(x1 => $x1, y1 => $y1, x2 => $x2, y2 => $y2, aa => 1, color => $color) || die $img->errstr;
 129       $img->circle(x => $x1, y => $y1, r => 3, aa => 1, filled => 1, @fill);
 130     }
 131
 132     my $x2 = $left + ($data_size - 1) * $size / ($data_size - 1);
 133     my $y2 = $bottom + ($value_range - $data[$data_size - 1] + $min_value)/$value_range * $size;
 134
 135     $img->circle(x => $x2, y => $y2, r => 3, aa => 1, filled => 1, @fill);
 136     $series_counter++;
 137   }
 138
 139   return $img;
 140 }
 141
 142 sub _drawYTics {
 143   my $self = shift;
 144   my $img = shift;
 145   my $min = shift;
 146   my $max = shift;
 147   my $tic_count = shift;
 148   my $graph_box = shift;
 149   my $image_box = shift;
 150
 151   my $interval = ($max - $min) / ($tic_count - 1);
 152
 153   my %text_info = $self->_text_style('legend')
 154     or return;
 155
 156   my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($tic_count - 1);
 157   for my $count (0 .. $tic_count - 1) {
 158     my $x1 = $graph_box->[0] - 5;
 159     my $x2 = $graph_box->[0] + 5;
 160     my $y1 = $graph_box->[3] - ($count * $tic_distance);
 161
 162     $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => '000000');
 163
 164     my $value = sprintf("%.2f", ($count*$interval)+$min);
 165
 166     my @box = $self->_text_bbox($value, 'legend')
 167       or return;
 168
 169     my $width = $box[2];
 170     my $height = $box[3];
 171
 172     $img->string(%text_info,
 173                  x    => ($x1 - $width - 3),
 174                  y    => ($y1 + ($height / 2)),
 175                  text => $value
 176                 );
 177   }
 178
 179 }
 180
 181 sub _drawXTics {
 182   my $self = shift;
 183   my $img = shift;
 184   my $graph_box = shift;
 185   my $image_box = shift;
 186
 187   my $labels = $self->_getLabels();
 188
 189   my $tic_count = (scalar @$labels) - 1;
 190
 191   my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($tic_count);
 192   my %text_info = $self->_text_style('legend')
 193     or return;
 194
 195   for my $count (0 .. $tic_count) {
 196     my $label = $labels->[$count];
 197     my $x1 = $graph_box->[0] + ($tic_distance * $count);
 198     my $y1 = $graph_box->[3] + 5;
 199     my $y2 = $graph_box->[3] - 5;
 200
 201     $img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => '000000');
 202
 203     my @box = $self->_text_bbox($label, 'legend')
 204       or return;
 205
 206     my $width = $box[2];
 207     my $height = $box[3];
 208
 209     $img->string(%text_info,
 210                  x    => ($x1 - ($width / 2)),
 211                  y    => ($y1 + ($height + 5)),
 212                  text => $label
 213                 );
 214
 215   }
 216 }
 217
 218 sub _validInput {
 219   my $self = shift;
 220
 221   if (!defined $self->_getDataSeries() || !scalar @{$self->_getDataSeries()}) {
 222     return $self->_error("No data supplied");
 223   }
 224
 225   if (!scalar @{$self->_getDataSeries()->[0]->{'data'}}) {
 226     return $self->_error("No values in data series");
 227   }
 228
 229   my @data = @{$self->_getDataSeries()->[0]->{'data'}};
 230
 231   return 1;
 232 }
 233
 234
 235
 236 1;
 237