File Coverage

blib/lib/Chart/Plot/Annotated.pm

Criterion	Covered	Total	%
statement	15	18	83.3
branch			n/a
condition			n/a
subroutine	5	6	83.3
pod			n/a
total	20	24	83.3

package Chart::Plot::Annotated;

use 5.006;
use strict;
use warnings;
use Carp;
our $VERSION = '0.01';

##################################################################
# define this class:
use base 'Chart::Plot';
use Class::MethodMaker
  # the extra data we'll put into the Chart::Plot object
  object_list => [ Chart::Plot::Annotated::_DataPt => '_AnnoData' ],

  # formatting internals
  get_set => [ qw [ _anno_xOffset _anno_yOffset _anno_font _anno_color ] ],

  # error-reporting
  get_set => [ '_problem' ];
##################################################################
# define an auxiliary class:
use Class::Struct Chart::Plot::Annotated::_DataPt =>
  [ X => '$', Y => '$', anno => '$' ];
##################################################################
# new public method:
sub setAnnoData {
  my $self = shift;
  my @annos = @{shift @_};

  my $rc = $self->setData(@_);
  if (not $rc) {
    return $rc;
  }

  # store the datapoints for later
  if (ref $_[0] eq 'ARRAY' and ref $_[1] eq 'ARRAY') {
    # x datapts and y datapts separated
    my (@x) = @{shift @_};
    my (@y) = @{shift @_};
    unless (@annos == @x) {
      $self->_problem("different numbers of annotations and x-values");
      return 0;
    }

    unless (@annos == @y) {
      $self->_problem("different numbers of annotations and y-values");
      return 0;
    }

    while (@annos) {
      my $datum =
	Chart::Plot::Annotated::_DataPt->new( X => shift @x,
					      Y => shift @y,
					      anno => shift @annos
					    );
      $self->push__AnnoData($datum);
    }
  }
  else {
    # assume X and Y datapoints presented as one array
    my @xy = @{shift @_};
    unless (@xy == 2*@annos) {
      $self->_problem("annos not synced with (x,y) values " .
		      "-- different numbers of elements");
      return 0;
    }
    while (@annos) {
      my $datum;
      my $anno = shift @annos;
      if (not defined $anno) {
	$anno = '';
      }
      $datum =
	Chart::Plot::Annotated::_DataPt->new( X => shift @xy,
					      Y => shift @xy,
					      anno => $anno );
      $self->push__AnnoData($datum);
    }
  }

  if (defined $_[0] and ref $_[0] eq 'ARRAY') {
    $self->_problem("too many arrayrefs to setAnnoData");
    return 0;
  }

  # arrive here? no problems.
  return 1;
}
##################################################################
# override base class to handle extra layer's new possible errors
sub error {
  my $self = shift;
  if (defined $self->_problem) {
    return $self->_problem();
  }
  # else call base class
  return $self->SUPER::error();
}
##################################################################
# override base class to handle extra layer's extra options
sub setGraphOptions {
  my $self = shift;
  my %args = @_;
  if (defined $args{anno_color}) {
    if (ref $args{anno_color} ne 'ARRAY') {
      $self->_problem("anno_color arg to setGraphOptions()" .
		      " needs arrayref value");
      return 0;
    }
    $self->_setAnnoColor(@{$args{anno_color}})
      or return 0; # problem?
    delete $args{anno_color};
  }

  if (defined $args{anno_xOffset}) {
    $self->_anno_xOffset($args{anno_xOffset});
    delete $args{anno_xOffset};
  }
  if (defined $args{anno_yOffset}) {
    $self->_anno_yOffset($args{anno_yOffset});
    delete $args{anno_yOffset};
  }

  # send remaining args to base class, if there are any left
  if (%args) {
    return $self->SUPER::setGraphOptions(%args);
  }
  else {
    # everything went fine!
    return 1;
  }
}
##################################################################
use GD; # use this to directly annotate the resulting plot with the
        # annotations.
##################################################################
# override base class to handle extra layer's extra markup on the
# image object
sub draw {
  my $self = shift;
  my $gdObj = $self->SUPER::getGDobject();

  if (not defined $self->_anno_color) {
    $self->_setAnnoColor(0,0,0); # black
  }
  if (not defined $self->_anno_font) {
    $self->_anno_font( gdTinyFont );
  }
  if (not defined $self->_anno_xOffset) {
    $self->_anno_xOffset( 0 );
  }
  if (not defined $self->_anno_yOffset) {
    $self->_anno_yOffset( 0 );
  }

  # set all the annotations
  while ($self->count__AnnoData) {
    my $datum = $self->shift__AnnoData;
    if (defined $datum->anno and length $datum->anno) {
      $self->_setAnno($gdObj, $datum);
    }
    # otherwise skip empty strings
  }

  # done with extra markup, now call base class draw; returning
  # whatever it does
  return $self->SUPER::draw();
}
##################################################################
# private methods
##################################################################
sub _setAnnoColor {
  # sets the annotation color to the appropriate color-triple. Used
  # for handling configuration data
  my $self = shift;
  my ($r, $g, $b) = @_;

  if (@_ < 3) {
    # fatal
    $self->_problem( "need 3 args to annotation color-setting" );
    return 0;
  }
  if (@_ > 3) {
    # non-fatal, though silly
    carp "_setAnnoColor args beyond (R,G,B) ignored";
  }

  my $gdObj = $self->SUPER::getGDobject();
  my $color = $gdObj->colorAllocate($r, $g, $b);

  $self->_anno_color($color);
  return 1;
}
##################################################################
sub _setAnno {
  # writes an annotation onto the base class Chart::Plot, given a
  # pointer to the GD Object underneath.
  my $self = shift;
  my $gdObj = shift;
  my $datum = shift;
  my ($xp, $yp) = $self->SUPER::data2pxl($datum->X, $datum->Y);
  $gdObj->string($self->_anno_font,
		 ($xp + $self->_anno_xOffset),
		 ($yp + $self->_anno_yOffset),
		 $datum->anno,
		 $self->_anno_color);
}
##################################################################
1;

__END__