File Coverage

blib/lib/GD/Sparkline.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

#########
# Author:        rmp
# Maintainer:    $Author: rmp $
# Created:       2008-12-01
# Last Modified: $Date$
# Id:            $Id$
# $HeadURL$
#
package GD::Sparkline;
use strict;
use warnings;
use GD;
use base qw(Class::Accessor);
use Readonly;
use Math::Bezier;

Readonly::Scalar our $H => 20;        # Height
Readonly::Scalar our $W => 80;        # Width
Readonly::Scalar our $T => 'b';       # Chart type
Readonly::Scalar our $B => q[FFFFFF]; # Background
Readonly::Scalar our $A => q[80D7B7]; # Area colour
Readonly::Scalar our $L => q[000000]; # Line colour
Readonly::Scalar our $BEZ_REZ => 10;

our $VERSION = q[0.05];

__PACKAGE__->mk_accessors(__PACKAGE__->fields());

sub fields {
  return qw(p s h w b a l t);
}

sub new {
  my ($class, $ref) = @_;

  if(!$ref) {
    $ref = {};
  }

  bless $ref, $class;
  return $ref;
}

sub draw { ## no critic (ProhibitExcessComplexity)
  my $self   = shift;
  my $raw    = $self->p();
  my $series = $self->s();
  my $p      = [];
  my ($min, $max);

  if($raw) {
    $p = [map { ## no critic (ProhibitComplexMappings)
      if(!defined $min || $_<$min){
	$min=$_;
      }

      if(!defined $max || $_>$max){
	$max=$_;
      }

      $_;
    } unpack q[C]x(length $raw), ($raw || q[])];

  } elsif($series) {
    $p = [map { ## no critic (ProhibitComplexMappings)
      if(!defined $min || $_<$min){
	$min=$_;
      }

      if(!defined $max || $_>$max){
	$max=$_;
      }

      $_;
    } split /,/smx, $series];
  }

  my $h     = $self->h || $H;
  my $w     = $self->w || $W;
  my $gd    = GD::Image->newTrueColor($w, $h);
  my $b_str = $self->b;

  if($b_str eq 'transparent') {
    $b_str = 'ffffff';
  }

  my $bg   = $gd->colorAllocate(map { hex $_ } unpack 'A2A2A2', $b_str || $B);
  my $area = $gd->colorAllocate(map { hex $_ } unpack 'A2A2A2', $self->a || $A);
  my $line = $gd->colorAllocate(map { hex $_ } unpack 'A2A2A2', $self->l || $L);

  if($self->b eq 'transparent') {
    $gd->transparent($bg);
  }

  $gd->filledRectangle(0,0, $w,$h, $bg);

  my $type = $self->t || $T;
  my $func = "type_$type";

  if($self->can($func)) {
    $self->$func($gd, $p,
		 {
		  min => $min,
		  max => $max,
		 },
		 {
		  line => $line,
		  area => $area,
		  h    => $h,
		  w    => $w,
		 });
  }

  return $gd->png();
}

sub type_b {
  my ($self, $gd, $p, $data_attrs, $chart_attrs) = @_;
  my $min  = $data_attrs->{min};
  my $max  = $data_attrs->{max};
  my $line = $chart_attrs->{line};
  my $area = $chart_attrs->{area};
  my $h    = $chart_attrs->{h} || $H;
  my $w    = $chart_attrs->{w} || $W;

  my $dy     = 0+$max-$min;
  my $dx     = scalar @{$p} - 1;
  my $scaley = $h/($dy||1);
  my $scalex = $w/($dx||1);
  my $pos    = 0;

  my $lastx = 0;
  my @controls;

  for my $d (@{$p}) {
    my $y = $h-($d-$min)*$scaley;
    my $x = $pos*$scalex;

    push @controls, ($x, $y);
    $pos++;
  }

  my $bezier  = Math::Bezier->new(@controls);
  my $pointsa = $bezier->curve($w);#10000);#$w/$BEZ_REZ);
  my $pointsl = [@{$pointsa}];

  my ($lx, $ly) = splice @{$pointsa}, 0, 2;
  while(scalar @{$pointsa}) {
    my ($x, $y) = splice @{$pointsa}, 0, 2;

    my $poly = GD::Polygon->new;
    $poly->addPt($lx, $ly);
    $poly->addPt($lx, $h);
    $poly->addPt($x, $h);
    $poly->addPt($x, $y);
    $gd->filledPolygon($poly, $area);
    $lx = $x;
    $ly = $y;
  }

  ($lx, $ly) = splice @{$pointsl}, 0, 2;
  $gd->setAntiAliased($line);

  while(scalar @{$pointsl}) {
    my ($x, $y) = splice @{$pointsl}, 0, 2;

    $gd->line($lx, $ly, $x, $y, gdAntiAliased);
    $lx = $x;
    $ly = $y;
  }

  return 1;
}

1;
__END__