File Coverage

blib/lib/GD/Chart/Radial.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

#####################################################################
# Radial - A module to generate radial charts as JPG and PNG images #
# (c) Copyright 2002,2004-2007 Aaron J  Trevena                     #
# (c) Copyright 2007-2013 Barbie                                    #
#####################################################################
package GD::Chart::Radial;

use strict;
use warnings;

use Data::Dumper;
use GD;

our $VERSION = '0.09';

=head1 NAME

GD::Chart::Radial - plot and output Radial or Radar charts using the GD library.

=head1 SYNOPSIS

  use GD::Chart::Radial;

  my $chart = GD::Chart::Radial->new($width, $height);
  $chart->set(title=>"This is a chart");
  $chart->plot(\@data);
  print OUTFILE $chart->png;

=head1 DESCRIPTION

This module allows you to plot and output Radial or Radar charts
using the GD library. The module is based on GD::Graph in how it
can be used where possible.

A radial chart has multiple axis spread out from the centre, like
spokes on a wheel. Each axis represents a particular measurement.
Values are plotted by marking the value for what is being measured
on each axis and optionally joining these points. The result can
look like a spiderweb or a radar depending on how you plot the
values.

=cut

my %COLOURS = (
    white      => [255,255,255],
    black      => [0,0,0],
    red        => [255,0,0],
    blue       => [0,0,255],
    purple     => [230,0,230],
    green      => [0,255,0],
    grey       => [128,128,128],
    light_grey => [170,170,170],
    dark_grey  => [75,75,75],
    cream      => [200,200,240],
    yellow     => [255,255,0],
    orange     => [255,128,0],
);

my %FONT = (
    1 => [5, gdSmallFont, gdTinyFont, gdTinyFont],
    2 => [10, gdMediumBoldFont, gdSmallFont, gdTinyFont],
    3 => [15, gdLargeFont, gdMediumBoldFont, gdSmallFont],
    4 => [20, gdGiantFont, gdLargeFont, gdMediumBoldFont],
    5 => [20, gdGiantFont, gdGiantFont, gdLargeFont],
    6 => [20, gdGiantFont, gdGiantFont, gdGiantFont],
);

my @FONT = sort keys %FONT;

=head1 METHODS

=head2 new

This constructor method creates a new chart object.

  my $chart = GD::Chart::Radial->new($width,$height);

=cut

sub new {
  my ($class, $width, $height, $debug) = (@_,0);

  # instantiate Chart
  my $chart = {};
  bless($chart, ref($class) || $class);

  # initialise Chart
  $chart->{width}  = $width;
  $chart->{height} = $height;
  $chart->{debug}  = $debug;
  $chart->{PI}     = 4 * atan2 1, 1;
  return $chart;
}

=head2 set

This accessor sets attributes of the graph such as the Title

  $chart->set(title=>"This is a chart");

or

  $chart->set(
        legend            => [qw/april may/],
        title             => 'Some simple graph',
        y_max_value       => $max,
        y_tick_number     => 5,
        style             => 'Notch',
        colours           => [qw/white black red blue green/],
       );

Style can be Notch, Circle, Polygon or Fill. The default style is Notch. Where
style is set to Fill, the data sets are also filled, as opposed to lines drawn
for all other styles

Colours can be any of the following: white, black, red, blue, purple, green,
grey, light_grey, dark_grey, cream, yellow, orange. The first colour is used
for the background colour, the second is used for the scale markings, while
the remaining colours represent the different data sets. If there are less
colours than data sets, colours will be taken from the unused set of defined
colours.

The default list of colours are white, black, red, blue and green, i.e. white
background, black scale markings and data sets in red blue and green.

Both legend and title can be undefined. If this is the case then the relavent
entry will not appear on the graph. This is useful if you plan to use other
forms of labelling along with the graph, and only require the image.

=cut

sub set {
  my $self = shift;
  my %attributes = @_;
  foreach my $attribute (%attributes) {
    next unless ($attributes{$attribute});
    $self->{$attribute} = $attributes{$attribute};
  }
}

=head2 plot

This method plots the chart based on the data provided and the attributes of
the graph.

  my @data = ([qw/A B C D E F G/],
              [12,21,23,30,23,22,5],
              [10,20,21,24,28,15,9]);
  $chart->plot(\@data);

=cut

sub plot {
  my $self = shift;
  return    unless(@_);

  my @values = @{shift()};
  my @labels = @{shift(@values)};
  my @records;

  if($self->{colours}) {
      for(@{$self->{colours}}) {
          next  unless(/^\#[a-f0-9]{3}([a-f0-9]{3})?$/i);
          my ($r,$g,$b);
          if(length($_) == 7) {
            my ($r,$g,$b) = (/^\#(..)(..)(..)$/);
            $COLOURS{$_} = [hex($r),hex($g),hex($b)];
          } else {
            my ($r,$g,$b) = (/^\#(.)(.)(.)$/);
            $COLOURS{$_} = [hex("$r$r"),hex("$g$g"),hex("$b$b")];
          }
      }

      # ensure we only have valid colours
      my @c = grep {$COLOURS{$_}} @{$self->{colours}};
      $self->{colours} = \@c;
  }

  my $BGColour  = $self->{colours} ? shift @{$self->{colours}} : 'white';
  my $FGColour  = $self->{colours} ? shift @{$self->{colours}} : 'black';
  my @DSColours = $self->{colours} ? @{$self->{colours}} : qw/red blue green yellow orange/;

  # try and avoid running out of colours
  my %AllColours = map {$_ => 1} keys %COLOURS;
  delete $AllColours{$_}   for($BGColour,$FGColour,@DSColours);
  push @DSColours, keys %AllColours;
  while(scalar(@labels) > scalar(@DSColours) || scalar(@values) > scalar(@DSColours)) {
    push @DSColours, @DSColours;
  }

#print STDERR "\n#Colours:";
#print STDERR "\n#Background=$BGColour";
#print STDERR "\n#Markings  =$FGColour";
#print STDERR "\n#Labels    =".(join(",",@DSColours));
#print STDERR "\n#Legends   =".(join(",",@{$self->{legend}}));
#print STDERR "\n";

#print STDERR "\n#Data:";
#print STDERR "\n#Labels=".(join(",",@labels));
#print STDERR "\n#Points=[".(join("][", map{join(",",@$_)} @values))."]";
#print STDERR "\n";

  my $Max = 0;
  my $r = 0;
  foreach my $values (@values) {
    my $record = { Colour => $DSColours[$r] };
    $record->{Label} = $self->{legend}->[$r]    if($self->{legend});
    my $v = 0;
    foreach my $value (@$values) {
      $record->{Values}->{$labels[$v]} = $value;
      $Max = $value if($Max < $value);
      $v++;
    }
    push(@records,$record);
    $r++;
  }

  $self->{records} = \@records;
  $self->{y_max_value}   ||= $Max;
  $self->{y_tick_number} ||= $Max;

  my $PI = $self->{PI};

  # style can be Fill, Circle, Polygon or Notch
  my %scale = (
           Max       => $self->{y_max_value},
           Divisions => $self->{y_tick_number},
           Style     => $self->{style} || "Notch",
           Colour    => $FGColour
          );

  # calculate image dimensions
  my (@axis, %axis_lookup);
  my $longest_axis_label = 0;
  my $a = 0;
  foreach my $key (@labels) {
    push (@axis, { Label => "$key" });
    $axis_lookup{$key} = $a;
    $longest_axis_label = length $key
      if (length $key > $longest_axis_label);
    $a++;
  }

  my $number_of_axis = scalar @axis;
  my $legend_height = 0;

  if($self->{legend}) {
      $legend_height = 8 + (15 * scalar @{$self->{records}});
  }

  my $left_space    = 15 + $longest_axis_label * 6;
  my $right_space   = 15 + $longest_axis_label * 6;
  my $top_space     = $self->{title} ? 50 : 15;
  my $bottom_space  = $self->{legend} ? 30 + $legend_height : 15;

  unless($self->{width})  { $self->{width}  = 200 + $left_space + $right_space; }
  unless($self->{height}) { $self->{height} = 200 + $top_space + $bottom_space; }

  my $x_radius = int(($self->{width}  - $left_space - $right_space) / 2);
  my $y_radius = int(($self->{height} - $top_space - $bottom_space) / 2);
  my $min_radius = 100;

  $x_radius = $min_radius   if($x_radius < $min_radius);
  $y_radius = $min_radius   if($y_radius < $min_radius);
  $x_radius = $y_radius     if($x_radius > $y_radius);
  $y_radius = $x_radius     if($y_radius > $x_radius);

  $top_space += _font_offset($x_radius);

  my $x_centre  = $left_space + $x_radius;
  my $y_centre  = $top_space + $y_radius;
  my $height    = (2 * $y_radius) + $bottom_space + $top_space;
  my $width     = (2 * $x_radius) + $left_space + $right_space;

#print STDERR "\n#width=$width, height=$height\n"  if($self->{debug});
  $self->{_im} = GD::Image->new($width,$height);

  # define the colours and fonts
  my %colours = map {$_ => $self->{_im}->colorAllocate(@{$COLOURS{$_}})} ($BGColour,$FGColour,@DSColours);
  $self->{fonts}   = {
      Title  => _font_size(1,$x_radius),
      Label  => _font_size(2,$x_radius),
      Legend => _font_size(3,$x_radius)
  };

  my (@Axis,@Label,@Notch);
  my $Theta = 90;
  my $i = $number_of_axis;
  foreach my $axis (@axis) {
    my ($proportion,$theta,$x,$y);

    if ($i > 0) {
      $proportion = $i / $number_of_axis;
      $theta = ((360 * $proportion) + $Theta) % 360;
      $axis->{theta} = $theta;
      $theta *= ((2 * $PI) / 360);
    } else {
      $axis->{theta} = $Theta;
      $theta = $Theta;
    }
    $x = cos $theta - (2 * $theta);
    $y = sin $theta - (2 * $theta);

    my $x_outer = ($x * $x_radius) + $x_centre;
    my $x_proportion =  ($x >= 0) ? $x : $x - (2 * $x) ;
    my $x_label = ($x_outer >= $x_centre)
                    ? $x_outer + 3
                    : $x_outer - ((length ( $axis->{Label} ) * 5) + (3 * $x_proportion));
    my $y_outer = ($y * $y_radius) + $y_centre;
    my $y_proportion =  ($y >= 0) ? $y : $y - (2 * $y) ;
    my $y_label = ($y_outer >= $y_centre)
                    ? $y_outer + (3 * $y_proportion)
                    : $y_outer - (9 * $y_proportion);

    $axis->{X} = $x;
    $axis->{Y} = $y;

    # round down coords
    $x_outer =~ s/(\d+)\..*/$1/;
    $y_outer =~ s/(\d+)\..*/$1/;
    $x_label =~ s/(\d+)\..*/$1/;
    $y_label =~ s/(\d+)\..*/$1/;

    # top label needs to be slightly offset to avoid the scale marking
    $y_label -= _font_offset($x_radius)  if($i == $number_of_axis);

    # draw axis and label
    if ($scale{Style} eq "Fill")  {
        push @Axis, [$x_outer, $y_outer, $x_centre, $y_centre, $colours{$scale{Colour}}];
        push @Label, [$x_label, $y_label, $axis->{Label}, $colours{$scale{Colour}}];
    } else {
        $self->{_im}->line($x_outer, $y_outer, $x_centre, $y_centre, $colours{$scale{Colour}});
        $self->{_im}->string($self->{fonts}->{Label}, $x_label, $y_label, $axis->{Label}, $colours{$scale{Colour}});
    }
    $i--;
  }

  # loop through adding scale, and values
  $r = 0;
  $i = 0;
  foreach my $axis (@axis) {
    my $x = $axis->{X};
    my $y = $axis->{Y};
    # draw scale
    my $theta1;
    my $theta2;
    if ($scale{Style} eq "Notch" || $scale{Style} eq "Fill")  {
      $theta1 = $axis->{theta} + 90;
      $theta2 = $axis->{theta} - 90;
      # convert theta to radians
      $theta1 *= ((2 * $PI) / 360);
      $theta2 *= ((2 * $PI) / 360);
      for (my $j = 0 ; $j <= $scale{Max} ; $j+=int($scale{Max} / $scale{Divisions})) {
        my $x_interval = $x_centre + ($x * ($x_radius / $scale{Max}) * $j);
        my $y_interval = $y_centre + ($y * ($y_radius / $scale{Max}) * $j);
        my $x1 = cos $theta1 - (2 * $theta1);
        my $y1 = sin $theta1 - (2 * $theta1);
        my $x2 = cos $theta2 - (2 * $theta2);
        my $y2 = sin $theta2 - (2 * $theta2);
        my $x1_outer = ($x1 * 3 * ($j / $scale{Max})) + $x_interval;
        my $y1_outer = ($y1 * 3 * ($j / $scale{Max})) + $y_interval;
        my $x2_outer = ($x2 * 3 * ($j / $scale{Max})) + $x_interval;
        my $y2_outer = ($y2 * 3 * ($j / $scale{Max})) + $y_interval;

        if($scale{Style} eq "Fill") {
          push @Notch, [$x1_outer,$y1_outer,$x_interval,$y_interval,$colours{$scale{Colour}}];
          push @Notch, [$x2_outer,$y2_outer,$x_interval,$y_interval,$colours{$scale{Colour}}];
        } else {
          $self->{_im}->line($x1_outer,$y1_outer,$x_interval,$y_interval,$colours{$scale{Colour}});
          $self->{_im}->line($x2_outer,$y2_outer,$x_interval,$y_interval,$colours{$scale{Colour}});
        }
      }
    }

    if ($scale{Style} eq "Polygon" || $scale{Style} eq "Fill")  {
      for (my $j = 0 ; $j <= $scale{Max} ; $j+=int($scale{Max} / $scale{Divisions})) {
        my $x_interval_1 = $x_centre + ($x * ($x_radius / $scale{Max}) * $j);
        my $y_interval_1 = $y_centre + ($y * ($y_radius / $scale{Max}) * $j);
        my $x_interval_2 = $x_centre + ($axis[$i-1]->{X} * ($x_radius / $scale{Max}) * $j);
        my $y_interval_2 = $y_centre + ($axis[$i-1]->{Y} * ($y_radius / $scale{Max}) * $j);

        if ($i > 0) {
          next if ($j == 0);
          $self->{_im}->line($x_interval_1,$y_interval_1,$x_interval_2,$y_interval_2,$colours{$scale{Colour}});
          if ($i == $number_of_axis -1) {
            my $x_interval_2 = $x_centre + ($axis[0]->{X} * ($x_radius / $scale{Max}) * $j);
            my $y_interval_2 = $y_centre + ($axis[0]->{Y} * ($y_radius / $scale{Max}) * $j);
            $self->{_im}->line($x_interval_1,$y_interval_1,$x_interval_2,$y_interval_2,$colours{$scale{Colour}});
          }
        }
      }
    }

    if ($scale{Style} eq "Circle")  {
      for (my $j = 0 ; $j <= $scale{Max} ; $j+=int($scale{Max} / $scale{Divisions})) {
        if ($i > 0) {
          next if ($j == 0);
          my $radius = (($y_radius * 2) / $scale{Max}) * $j;
          $self->{_im}->arc($x_centre,$y_centre,$radius,$radius,$axis[0]->{theta}-2,$axis[$i-1]->{theta}-2,$colours{$scale{Colour}});
          $self->{_im}->arc($x_centre,$y_centre,$radius,$radius,$axis[$i]->{theta}-2,$axis[0]->{theta}-2,$colours{$scale{Colour}});
        }
      }
    }

    # draw graph points
    if ($i != 0) {
      my $r = 0;
      foreach my $record (@{$self->{records}}) {
        my $value = $record->{Values}->{$axis->{Label}};
        my $colour = $colours{$record->{Colour}};
        $value ||= 0;
#print STDERR "Max=[$scale{Max}], value=[$value]"    if($self->{debug});
        my $x_interval_1 = $x_centre + ($x * ($x_radius / $scale{Max}) * $value);
        my $y_interval_1 = $y_centre + ($y * ($y_radius / $scale{Max}) * $value);

        if ($scale{Style} eq "Fill")  {
          push @{$record->{Points}}, [$x_interval_1,$y_interval_1];
          if ($i == $number_of_axis -1) {
            my $first_value  = $record->{Values}->{$axis[0]->{Label}};
            my $x_interval_2 = $x_centre + ($axis[0]->{X} * ($x_radius / $scale{Max}) * $first_value);
            my $y_interval_2 = $y_centre + ($axis[0]->{Y} * ($y_radius / $scale{Max}) * $first_value);
            push @{$record->{Points}}, [$x_interval_2,$y_interval_2];
          }
        } else {
          $self->draw_shape($x_interval_1,$y_interval_1,$colours{$record->{Colour}}, $r);

          my $last_value = $record->{Values}->{$axis[$i-1]->{Label}};
          my $x_interval_2 = $x_centre + ($axis[$i-1]->{X} * ($x_radius / $scale{Max}) * $last_value);
          my $y_interval_2 = $y_centre + ($axis[$i-1]->{Y} * ($y_radius / $scale{Max}) * $last_value);
          $self->{_im}->line($x_interval_1,$y_interval_1,$x_interval_2,$y_interval_2,$colour);

          if ($i == $number_of_axis -1) {
            my $first_value  = $record->{Values}->{$axis[0]->{Label}};
            my $x_interval_2 = $x_centre + ($axis[0]->{X} * ($x_radius / $scale{Max}) * $first_value);
            my $y_interval_2 = $y_centre + ($axis[0]->{Y} * ($y_radius / $scale{Max}) * $first_value);
            $self->{_im}->line($x_interval_1,$y_interval_1,$x_interval_2,$y_interval_2,$colour);
            $self->draw_shape($x_interval_2,$y_interval_2,$colours{$record->{Colour}}, $r);
          }
          $r++;
        }
      }
    }
    $i++;
  }

  # Fill is a filled polgon
  if ($scale{Style} eq "Fill")  {
    foreach my $record (@{$self->{records}}) {
      my $poly = GD::Polygon->new();
      $poly->addPt($_->[0],$_->[1]) for(@{$record->{Points}});
      $self->{_im}->filledPolygon($poly,$colours{$record->{Colour}});
    }

    $self->{_im}->line(@$_)                             for(@Axis,@Notch);
    $self->{_im}->string($self->{fonts}->{Label},@$_)   for(@Label);
  }

  # draw scale values
  my $x = $axis[0]->{X};
  my $y = $axis[0]->{Y};
  for (my $j = 0 ; $j <= $scale{Max} ; $j+=int($scale{Max} / $scale{Divisions})) {
    my $x_interval_1 = $x_centre + ($x * ($x_radius / $scale{Max}) * $j);
    my $y_interval_1= $y_centre + ($y * ($y_radius / $scale{Max}) * $j);
    $self->{_im}->string($self->{fonts}->{Legend}, $x_interval_1 + 2,$y_interval_1 - 4,$j,$colours{$scale{Colour}});
  }

  # draw Legend
  if($self->{legend}) {
    my $longest_legend = 0;
    foreach my $record (@{$self->{records}}) {
      $longest_legend = length $record->{Label}
        if ( $record->{Label} && length $record->{Label} > $longest_legend );
    }
    my ($legendX, $legendY) = (
           ($width / 2) - (6 * (length "Legend") / 2) - ($x_radius * 0.75),
           ($height - ($legend_height + 20))
    );
    $self->{_im}->string($self->{fonts}->{Legend},$legendX,$legendY,"Legend",$colours{$scale{Colour}});
    my $legendX2 = $legendX - (($longest_legend * 5) + 2);
    $legendY += 15;
    $r = 0;

    foreach my $record (@{$self->{records}}) {
      $self->{_im}->string($self->{fonts}->{Label},$legendX2,$legendY,$record->{Label},$colours{$record->{Colour}})  if($record->{Label});
      $self->{_im}->line($legendX+10,$legendY+4,$legendX + 35,$legendY+4,$colours{$record->{Colour}});
      $self->draw_shape($legendX+22,$legendY+4,$colours{$record->{Colour}},$r);
      $legendY += 15;
      $r++;
    }
  }

  # draw title
  if($self->{title}) {
      my ($titleX, $titleY) = ( ($width / 2) - (6 * (length $self->{title}) / 2),20);
      $self->{_im}->string($self->{fonts}->{Title},$titleX,$titleY,$self->{title},$colours{$scale{Colour}});
  }
  return 1;
}

=head2 png

returns a PNG image for output to a file or wherever.

  open(IMG, '>test.png') or die $!;
  binmode IMG;
  print IMG $chart->png;
  close IMG

=cut

sub png {
  my $self = shift;
  return    unless($self->{_im}->can('png'));
  return $self->{_im}->png();
}

=head2 jpg

returns a JPEG image for output to a file or elsewhere, see png.

=cut

sub jpg {
  my $self = shift;
  return    unless($self->{_im}->can('jpeg'));
  return $self->{_im}->jpeg(95);
}

=head2 gif

returns a GIF image for output to a file or elsewhere, see png.

=cut

sub gif {
  my $self = shift;
  return    unless($self->{_im}->can('gif'));
  return $self->{_im}->gif();
}

=head2 gd

returns a GD image for output to a file or elsewhere, see png.

=cut

sub gd {
  my $self = shift;
  return    unless($self->{_im}->can('gd'));
  return $self->{_im}->gd();
}

##########################################################

=head2 Internal Methods

In order to draw the points on the chart, the following 6 shape drawing
functions are used:

=over 4

=item draw_shape

=item draw_diamond

=item draw_square

=item draw_circle

=item draw_triangle

=item draw_cross

=back

=cut

sub draw_shape {
    my ($self,$x,$y,$colour,$i) = @_;
    my $shape;
    if (exists $self->{records}->[$i]->{Shape} ) {
        $shape = $self->{records}->[$i]->{Shape};
    } else {
        $shape = ($i > 4) ? int ($i % 5)  : $i ;
        $self->{records}->[$i]->{Shape} = $shape;
    }

    if ($shape == 0) {
        $self->draw_diamond($x,$y,$colour);
        return 1;
    }
    if ($shape == 1) {
        $self->draw_square($x,$y,$colour);
        return 1;
    }
    if ($shape == 2) {
        $self->draw_circle($x,$y,$colour);
        return 1;
    }
    if ($shape == 3) {
        $self->draw_triangle($x,$y,$colour);
        return 1;
    }
    if ($shape == 4) {
        $self->draw_cross($x,$y,$colour);
        return 1;
    }
}

sub draw_diamond {
    my ($self,$x,$y,$colour) = @_;
    $x-=3;
    my $poly = new GD::Polygon;
    $poly->addPt($x,$y);
    $poly->addPt($x+3,$y-3);
    $poly->addPt($x+6,$y);
    $poly->addPt($x+3,$y+3);
    $poly->addPt($x,$y);
    $self->{_im}->filledPolygon($poly,$colour);
    return 1;
}

sub draw_square {
    my ($self,$x,$y,$colour) = @_;
    $x-=3;
    $y-=3;
    my $poly = new GD::Polygon;
    $poly->addPt($x,$y);
    $poly->addPt($x+6,$y);
    $poly->addPt($x+6,$y+6);
    $poly->addPt($x,$y+6);
    $poly->addPt($x,$y);
    $self->{_im}->filledPolygon($poly,$colour);
    return 1;
}

sub draw_circle {
    my ($self,$x,$y,$colour) = @_;
    $self->{_im}->arc($x,$y,7,7,0,360,$colour);
    $self->{_im}->fillToBorder($x,$y,$colour,$colour);
    return 1;
}

sub draw_triangle {
    my ($self,$x,$y,$colour) = @_;
    $x-=3;
    $y+=3;
    my $poly = new GD::Polygon;
    $poly->addPt($x,$y);
    $poly->addPt($x+3,$y-6);
    $poly->addPt($x+6,$y);
    $poly->addPt($x,$y);
    $self->{_im}->filledPolygon($poly,$colour);
    return 1;
}

sub draw_cross {
    my ($self,$x,$y,$colour) = @_;
    $self->{_im}->line($x-3,$y,$x+3,$y,$colour);
    $self->{_im}->line($x,$y-3,$x,$y+3,$colour);
    return 1;
}

sub _font_size {
    my $scale  = shift || 1;
    my $radius = int((shift || $FONT[0]) / 100 );
    $radius = $FONT[0]  if($radius < $FONT[0]);
    $radius = $FONT[-1] if($radius > $FONT[-1]);

    return $FONT{$radius}->[$scale];
}

sub _font_offset {
    my $radius = int((shift || $FONT[0]) / 100 );

    return $FONT{$radius}->[0];
}

1;
__END__