File Coverage

blib/lib/SVGGraph.pm

Criterion	Covered	Total	%
statement	9	195	4.6
branch	0	76	0.0
condition	0	3	0.0
subroutine	3	10	30.0
pod	0	7	0.0
total	12	291	4.1

package SVGGraph;

use strict;
use warnings;
use utf8;
our $VERSION = '0.07';

sub new()
{
  my $self = shift;
  return bless {}, $self;
}

sub CreateGraph()
{
  ### First element of @_ is a reference to the element that called this subroutine
  my $self = shift;
  ### Second is a reference to a hash with options
  my $options = shift;
  ### The options passed in the anonymous hash are optional so create a default value first
  my $horiUnitDistance = 20;
  if ($$options{'horiunitdistance'})
  {
    $horiUnitDistance = $$options{'horiunitdistance'};
  }
  my $graphType = 'spline';
  if ($$options{'graphtype'})
  {
    $graphType = $$options{'graphtype'};
  }
  ### The rest are references to arrays with references to arrays with x and y values
  my @xyArrayRefs = @_;
  ### Check if the color ($xyArrayRefs[$i]->[3]) is provided. If not, choose black
  for (my $i = 0; $i < @xyArrayRefs; $i++)
  {
    unless ($xyArrayRefs[$i]->[3])
    {
      $xyArrayRefs[$i]->[3] = '#000000';
    }
  }
  ### Declare the $minX as the lowest value of x in the arrays, same for $minY, $maxX and $maxY
  my $minX = $xyArrayRefs[0]->[0]->[0]; ### Equivalent to ${${$xyArrayRefs[0]}[0]}[0];
  my $minY = $xyArrayRefs[0]->[1]->[0];
  my $maxX = $minX;
  my $maxY = $minY;
  ### Then really search for the lowest and highest value of x and y
  for (my $i = 0; $i < @xyArrayRefs; $i++)
  {
    for (my $j = 0; $j < @{$xyArrayRefs[$i]->[0]}; $j++)
    {
      if ($xyArrayRefs[$i]->[0]->[$j] > $maxX)
      {
        $maxX = $xyArrayRefs[$i]->[0]->[$j];
      }
      if ($xyArrayRefs[$i]->[0]->[$j] < $minX)
      {
        $minX = $xyArrayRefs[$i]->[0]->[$j];
      }
      if ($xyArrayRefs[$i]->[1]->[$j] > $maxY)
      {
        $maxY = $xyArrayRefs[$i]->[1]->[$j];
      }
      if ($xyArrayRefs[$i]->[1]->[$j] < $minY)
      {
        $minY = $xyArrayRefs[$i]->[1]->[$j];
      }
    }
  }
  ### If max equals min, change them artificially
  if ($maxX == $minX)
  {
    $maxX += 1;
  }
  if ($maxY == $minY)
  {
    $maxY += 1;
  }
  ### Calculate all dimensions neccessary to create the Graph
  ### Height of the total svg image in pixels:
  my $imageHeight = 400;
  if ($$options{'imageheight'})
  {
    $imageHeight = $$options{'imageheight'};
  }
  ### Width of the verticabar or dots in the graph
  my $barWidth = 3;
  if ($$options{'barwidth'})
  {
    $barWidth = $$options{'barwidth'};
  }
  ### Distance between the sides of the gris and the sides of the image:
  my $cornerDistance = 50;
  ### Since svg counts from the top left corner of the image, we translate all coordinates vertically in pixels:
  my $vertTranslate = $imageHeight - $cornerDistance;
  ### The width of the grid in pixels:
  my $gridWidth = $horiUnitDistance * ($maxX - $minX);
  ### The height of the grid in pixels:
  my $gridHeight = $imageHeight - 2 * $cornerDistance;
  ### The width of the whole svg image:
  my $imageWidth = $gridWidth + (4 * $cornerDistance);
  ### The horizontal space between vertical gridlines in pixels:
  my $xGridDistance = 20;
  ### The vertical space between horizontal gridlines in pixels:
  my $yGridDistance = 30;

  ### Now initiate the svg graph by declaring some general stuff.
  my $svg .= <<"  EOF";




  EOF
  if ($graphType eq 'spline')
  {
    for (my $i = 0; $i < @xyArrayRefs; $i++)
    {
      $svg .= $self->CreateDot(0, 0, $barWidth, $xyArrayRefs[$i]->[3], $i);
    }
  }
  $svg .= <<"  EOF";
<![CDATA[ </td>
</tr>

<tr>
<td  class="h" >
<a name="122">122</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> .nx </td>
</tr>

<tr>
<td  class="h" >
<a name="123">123</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> { </td>
</tr>

<tr>
<td  class="h" >
<a name="124">124</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">   text-anchor: middle; </td>
</tr>

<tr>
<td  class="h" >
<a name="125">125</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">   font-size: 8; </td>
</tr>

<tr>
<td  class="h" >
<a name="126">126</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> } </td>
</tr>

<tr>
<td  class="h" >
<a name="127">127</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> .ny </td>
</tr>

<tr>
<td  class="h" >
<a name="128">128</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> { </td>
</tr>

<tr>
<td  class="h" >
<a name="129">129</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">   text-anchor: end; </td>
</tr>

<tr>
<td  class="h" >
<a name="130">130</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">   font-size: 8; </td>
</tr>

<tr>
<td  class="h" >
<a name="131">131</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> } </td>
</tr>

<tr>
<td  class="h" >
<a name="132">132</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> .g </td>
</tr>

<tr>
<td  class="h" >
<a name="133">133</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> { </td>
</tr>

<tr>
<td  class="h" >
<a name="134">134</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">   stroke: #000000; </td>
</tr>

<tr>
<td  class="h" >
<a name="135">135</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">   fill: none; </td>
</tr>

<tr>
<td  class="h" >
<a name="136">136</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">   stroke-width: 0.5; </td>
</tr>

<tr>
<td  class="h" >
<a name="137">137</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">   stroke-dasharray:4 4; </td>
</tr>

<tr>
<td  class="h" >
<a name="138">138</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> } </td>
</tr>

<tr>
<td  class="h" >
<a name="139">139</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> ]]>


  EOF

  ### make x- and y axes
  $svg .= "\n";

  ### print numbers on y axis and horizontal gridlines
  ### First calculate the width between the gridlines in y-units, not in pixels
  my $deltaYUnits = $self->NaturalRound ($yGridDistance * ($maxY - $minY) / $gridHeight);
  ### Adjust $minX and $maxX so the gridlines and numbers startand end in a whole and nice number.
  $minY = int ($minY / $deltaYUnits - 0.999999999999) * $deltaYUnits;
  $maxY = int ($maxY / $deltaYUnits + 0.999999999999) * $deltaYUnits;
  ### Calculate the number of pixels each units stands for.
  my $yPixelsPerUnit = ($gridHeight / ($maxY - $minY));
  my $deltaYPixels = $deltaYUnits * $yPixelsPerUnit;
  ### Calculate the amount of gridlines and therefore the amount of numbers on the y-axis
  my $yNumberOfNumbers = int ($gridHeight / $deltaYPixels) + 1;
  ### Draw the numbers and the gridlines
  for (my $i = 0; $i < $yNumberOfNumbers; $i++)
  {
    my $YValue = sprintf ("%1.2f", (-1 * $i * $deltaYPixels)) + 0;
    ### numbers
    $svg .= "" . ($minY + $i * $deltaYUnits) . "\n";
    ### gridline
    if ($i != 0)
    {
      $svg .= "\n";
    }
  }

  ### print numbers on x axis and vertical gridlines
  my $deltaXUnits = $self->NaturalRound ($xGridDistance * ($maxX - $minX) / $gridWidth);
  my $xPixelsPerUnit = ($gridWidth / ($maxX - $minX));
  my $deltaXPixels = $deltaXUnits * $xPixelsPerUnit;
  my $xNumberOfNumbers = int ($gridWidth / $deltaXPixels) + 1;
  for (my $i = 0; $i < $xNumberOfNumbers; $i++)
  {
    my $XValue = sprintf ("%1.2f", ($i * $deltaXPixels)) + 0;
    ### numbers
    $svg .= "" . ($minX + $i * $deltaXUnits) . "\n";
    ### gridline
    if ($i != 0)
    {
      $svg .= "\n";
    }
  }

  ### print measurepoints (dots) (data) (coordinates)
  ### Spline
  if ($graphType eq 'spline')
  {
    for (my $i = 0; $i < @xyArrayRefs; $i++)
    {
      my $dots;
      for (my $dotNumber = 0; $dotNumber < @{$xyArrayRefs[$i]->[0]}; $dotNumber++)
      {
        my $dotX = $horiUnitDistance * ($xyArrayRefs[$i]->[0]->[$dotNumber] - $minX);
        my $dotY = sprintf ("%1.2f", -1 * $yPixelsPerUnit * ($xyArrayRefs[$i]->[1]->[$dotNumber] - $minY)) + 0;
        $dots .= "\n";
        if ($dotNumber == 0)
        {
          $svg .= "
        }
        else
        {
          $svg .= " L$dotX $dotY";
        }
      }
      $svg .= "\" style=\"fill: none; stroke: " . $xyArrayRefs[$i]->[3] . "; stroke-width:2\"/>\n$dots";
    }
  }
  ### Vertical Bars
  elsif ($graphType eq 'verticalbars')
  {
    for (my $dotNumber = 0; $dotNumber < @{$xyArrayRefs[0]->[0]}; $dotNumber++)
    {
      ### The longest bars must be drawn first, so that the shorter bars are drwan on top of the longer.
      ### So we sort $i (the number of the graph) to the length of the bar for each point.
      foreach my $i (sort {$xyArrayRefs[$b]->[1]->[$dotNumber] <=> $xyArrayRefs[$a]->[1]->[$dotNumber]} (0 .. $#xyArrayRefs))
      {
        my $lineX = $horiUnitDistance * ($xyArrayRefs[$i]->[0]->[$dotNumber] - $minX);
        my $lineY1 = 0;
        if (($minY < 0) && ($maxY > 0))
        {
          $lineY1 = $yPixelsPerUnit * $minY;
        }
        elsif ($maxY < 0)
        {
          $lineY1 = -1 * 1;
        }
        my $lineY2 = sprintf ("%1.2f", -1 * $yPixelsPerUnit * ($xyArrayRefs[$i]->[1]->[$dotNumber] - $minY)) + 0;
        $svg .= "[3] . ";stroke-width:$barWidth;\"/>\n";
      }
    }
  }

  ### print Title, Labels and Legend
  ### Title
  if ($$options{'title'})
  {
    my $titleStyle = 'font-size:24;';
    if ($$options{'titlestyle'})
    {
      $titleStyle = $self->XMLEscape($$options{'titlestyle'});
    }
    $svg .= "" . $self->XMLEscape($$options{'title'}) . "\n";
  }
  ### x-axis label
  if ($$options{'xlabel'})
  {
    my $xLabelStyle = 'font-size:16;';
    if ($$options{'xlabelstyle'})
    {
      $xLabelStyle = $self->XMLEscape($$options{'xlabelstyle'});
    }
    $svg .= "" . $self->XMLEscape($$options{'xlabel'}) . "\n";
  }
  ### y-axis label
  if ($$options{'ylabel'})
  {
    my $yLabelStyle = 'font-size:16;';
    if ($$options{'ylabelstyle'})
    {
      $yLabelStyle = $self->XMLEscape($$options{'ylabelstyle'});
    }
    $svg .= "" . $self->XMLEscape($$options{'ylabel'}) . "\n";
  }
  ### Legend
  my $legendOffset = ($cornerDistance + $gridWidth + 10) . ", $cornerDistance";
  if ($$options{'legendoffset'})
  {
    $legendOffset = $self->XMLEscape($$options{'legendoffset'});
  }
  $svg .= "\n\n";
  for (my $i = 0; $i < @xyArrayRefs; $i++)
  {
    if ($xyArrayRefs[$i]->[2])
    {
      my $y = 12 * $i;
      if ($graphType eq 'spline')
      {
        ### The line
        $svg .= "[3] . "\"/>\n";
        ### The dot
        $svg .= $self->CreateDot(8, $y, 3, $xyArrayRefs[$i]->[3], $i);
      }
      ### The text
      $svg .= "[3] . "\">" . $xyArrayRefs[$i]->[2] . "\n";
    }
  }
  $svg .= "\n\n";
  return $svg;
}

### CreateDot is a subroutine that creates the svg code for different
### kinds of dots used in the spline graph type: circles, squares, triangles and more.
sub CreateDot($$$$$)
{
  my $self = shift;
  my $x = shift;
  my $y = shift;
  my $r = shift;
  my $color = shift;
  $color = $self->DarkenHexRGB($color);
  my $dotNumber = shift;
  my $d = 2 * $r;
  my $negr = -1 * $r;
  my $svg;
  ### Circle
  if ($dotNumber == 0)
  {
    $svg = "\n";
  }
  ### Stars
  else
  {
    $svg .= "
    for (my $i = 1; $i <= (2*$dotNumber+2); $i++)
    {
      my $radius = ($i % 2) ? $r*1.5 : $r/2;
      my $pi = atan2(1,1) * 4;
      my $alpha = $i * ($pi / ($dotNumber + 1));
      my $xi = $x + $radius * cos($alpha);
      my $yi = $y + $radius * sin($alpha);
      $svg .= ($i == 1) ? "M" : "L";
      $svg .= sprintf (" %1.3f ", $xi) . (sprintf (" %1.3f ", $yi) + 0);
    }
    $svg .=  "z\" style=\"fill: $color; stroke: $color;\"/>\n";
  }
  return $svg;
}

### NaturalRound is a subroutine that rounds a number to 1, 2, 5 or 10 times its order
### So 110.34 becomes 100
### 3.1234 becomes 2
### 40 becomes 50

sub NaturalRound($)
{
  my $self = shift;
  my $numberToRound = shift;
  my $rounded;
  my $order = int (log ($numberToRound) / log (10));
  my $remainder = $numberToRound / 10**$order;
  if ($remainder < 1.4)
  {
    $rounded = 10**$order;
  }
  elsif ($remainder < 3.2)
  {
    $rounded = 2 * 10**$order;
  }
  elsif ($remainder < 7.1)
  {
    $rounded = 5 * 10**$order;
  }
  else
  {
    $rounded = 10 * 10**$order;
  }
}

### DarkenHexRGB is a subroutine that makes a rgb color value darker

sub DarkenHexRGB($)
{
  my $self = shift;
  my $hexString = shift;
  my $darkHexString;
  if ($hexString =~ m/^\#/)
  {
    $darkHexString = '#';
  }
  if ($hexString =~ m/^\#?[0-9a-f]{6}$/i)
  {
    while ($hexString =~ m/([0-9a-f][0-9a-f])/ig)
    {
      $darkHexString .= sprintf "%02lx", int(hex($1)/2);
    }
    return $darkHexString;
  }
  else
  {
    return $hexString;
  }
}

sub NegateHexadecimalRGB($)
{
  my $self = shift;
  my $hexString = shift;
  my $negHexString;
  if ($hexString =~ m/^\#/)
  {
    $negHexString = '#';
  }
  while ($hexString =~ m/([0-9a-f]{2})/ig)
  {
    $negHexString .= sprintf "%02lx", (255 - hex($1));
  }
  return $negHexString;
}

### XMLEscape is a subroutine that converts special XML characters to their xml encoding character.

sub XMLEscape($)
{
  my $self = shift;
  my $string = shift;
  unless (defined ($string))
  {
    $string = '';
  }
  $string =~ s/\&/&/g;
  $string =~ s/>/>/g;
  $string =~ s/
  $string =~ s/\"/"/g;
  $string =~ s/\'/'/g;
  #$string =~ s/([\x00-\x1f])/sprintf('&#x%02X;', ord($1))/ge;
  $string =~ s/([\x{80}-\x{ffff}])/sprintf('&#x%04X;', ord($1))/ge;
  return $string;
}

1;

__END__