root/veekun/trunk/lib/Vee/Utils/SVG.pm

package Vee::Utils::SVG;

use strict;
use warnings;
use constant PI => 3.14159265359;
use List::Util qw/sum/;
use Exporter 'import';
our @EXPORT = qw/piechart histogram/;

=head1 NAME

Vee::Controller::Utils::SVG - Catalyst Controller

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=cut

=head2 piechart

THIS IS NOT A METHOD.

Returns an SVG pie chart, given a list of fields and a list of data points.
Eventually I'd like to split this off into its own module.

=cut

my $default_svg_pie_css = <<END_CSS;
circle#pie {
    stroke: black;
    stroke-width: 2px;
    fill: white;
}

path.slice {
    fill-opacity: 0.67;
    fill: white;
    stroke: black;
    stroke-width: 1px;
}

rect.legend-frame {
    fill: white;
    fill-opacity: 0.0;
    stroke: transparent;
    stroke-width: 1px;
}

text.legend-label {
    text-anchor: start;
    dominant-baseline: middle;
}

.field:hover .slice {
    fill-opacity: 0.33;
}
.field:hover .legend-frame {
    fill-opacity: 0.75;
    stroke: #c0c0c0;
}

#field1  .slice, #field1  .legend-box { fill: #ff0000; }
#field2  .slice, #field2  .legend-box { fill: #ff8000; }
#field3  .slice, #field3  .legend-box { fill: #ffff00; }
#field4  .slice, #field4  .legend-box { fill: #80ff00; }
#field5  .slice, #field5  .legend-box { fill: #00ff00; }
#field6  .slice, #field6  .legend-box { fill: #00ff80; }
#field7  .slice, #field7  .legend-box { fill: #00ffff; }
#field8  .slice, #field8  .legend-box { fill: #0080ff; }
#field9  .slice, #field9  .legend-box { fill: #0000ff; }
#field10 .slice, #field10 .legend-box { fill: #8000ff; }
#field11 .slice, #field11 .legend-box { fill: #ff00ff; }
#field12 .slice, #field12 .legend-box { fill: #ff0080; }
END_CSS

sub piechart {
    my ($fields, $data, $opts) = @_;
    my @fields = @$fields;
    my @data   = @$data;
    
    my $total = sum @data;
    
    # some default values that should be overridden!
    my $scale = $opts->{scale} || 1;
    my $pie_radius = 100 * $scale;
    my $pie_padding = 10;
    
    # calculated now for convenience
    my $pie_diameter = $pie_radius * 2;
    my $width = $pie_diameter + $pie_padding * 2;
    my $height = $pie_diameter + $pie_padding * 2;
    $width *= 2;
    # scaling makes things dumb
    $width *= 2 if ($scale < 1);
    my ($center_x, $center_y) = ($pie_radius + $pie_padding) x 2;
    
    my $svg = qq[<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">\n];
    $svg   .= qq[<svg width="$width" height="$height" viewBox="0 0 $width $height" xmlns="http://www.w3.org/2000/svg">\n];
    $svg   .= qq[<style type="text/css">\n];
    $svg   .= $default_svg_pie_css;
    $svg   .= qq[</style>\n];
    
    # if there are no fields and/or data, this won't work!
    if (!@fields || !@data || $total < 1) {
        $svg   .= qq[<g class="field">];
        $svg   .= qq[ <text x="18" y="12" class="legend-label">There is no data to display.</text>\n</g>\n</svg>];
        return $svg;
    }
    
    my $legend_left = $pie_diameter + $pie_padding * 3;
    my $legend_row_height = $pie_diameter / @fields;
    my $legend_box_size = $legend_row_height * 2 / 3;

    $svg   .= qq[<circle cx="$center_x" cy="$center_y" r="$pie_radius" id="pie"/>\n];

    my $angle = 0;
    my $last_x = sprintf '%.3f', $center_x + $pie_radius * cos $angle;
    my $last_y = sprintf '%.3f', $center_y + $pie_radius * sin $angle;
    for my $i (0 .. $#data) {
        my $field = $fields[$i];
        my $datum = $data[$i];
        my $ratio = $datum / $total;
        
        $angle += $ratio * 2 * PI;
        $angle /=2 if ($ratio == 1); #if angle is 360, make it 180 (see hack below)
        my $to_x = sprintf '%.3f', $center_x + $pie_radius * cos $angle;
        my $to_y = sprintf '%.3f', $center_y + $pie_radius * sin $angle;
        
        $svg .= qq[<g class="field" id="field@{[ $i + 1 ]}" title="@{[ $datum . sprintf(" (%.0f%%)", ($ratio * 100)) ]}">\n];
        
        # slice itself
        $svg .= qq[    <path d="];
        $svg .= qq[ M$last_x $last_y ];
        # kind of hacky: if the angle is 360, draw 180 degrees of the circle, then draw the other 180 degrees
        # breaks in firefox otherwise
        if ($ratio == 1) {
            $svg .= qq[ A$pie_radius $pie_radius 0 1,1 $to_x $to_y ];
            $svg .= qq[ A$pie_radius $pie_radius 0 1,1 $last_x $last_y ];
        } else {
            $svg .= qq[ A$pie_radius $pie_radius 0 @{[ $ratio > 0.5 ? 1 : 0 ]},1 $to_x $to_y ];
        }
        $svg .= qq[ L$center_x $center_y ] unless ($ratio == 0 || $ratio == 1);
        $svg .= qq[ Z ];
        $svg .= qq[" class="slice"/>\n];
        
        # legend
        my $legend_row_y   = $pie_padding + $legend_row_height * $i;
        my $legend_box_y   = $legend_row_y + $legend_row_height * 0.1667;   # top of box
        my $legend_box_x   = $legend_left  + $legend_row_height * 0.1667;   # left of box
        my $legend_label_x = $legend_left + $legend_row_height;
        my $legend_label_y = $legend_row_y + $legend_row_height * 0.5;      # middle of text
        $svg .= qq[    <rect x="$legend_left" y="$legend_row_y" width="@{[ $width - $legend_left ]}" height="$legend_row_height" class="legend-frame"/>\n];
        $svg .= qq[    <rect x="$legend_box_x" y="$legend_box_y" width="$legend_box_size" height="$legend_box_size" rx="2" class="legend-box"/>\n];
        $svg .= qq[    <text x="$legend_label_x" y="$legend_label_y" class="legend-label">$field ];
        $svg .= qq[</text>\n];

        $svg .= qq[</g>\n];

        $last_x = $to_x;
        $last_y = $to_y;
    }

    $svg .= qq[ </svg> ];

    return $svg;
}

=head2 histogram

THIS IS NOT A METHOD.

Returns an SVG histogram, given a list of data points.
Eventually I'd like to split this off into its own module.

=cut

my $default_svg_histogram_css = <<END_CSS;
circle#pie {
    stroke: black;
    stroke-width: 2px;
    fill: white;
}

path.slice {
    fill-opacity: 0.7;
    fill: white;
    stroke: black;
    stroke-width: 1px;
}

#field1  .slice { fill: #ff0000; }
#field2  .slice { fill: #ff8000; }
#field3  .slice { fill: #ffff00; }
#field4  .slice { fill: #80ff00; }
#field5  .slice { fill: #00ff00; }
#field6  .slice { fill: #00ff80; }
#field7  .slice { fill: #00ffff; }
#field8  .slice { fill: #0080ff; }
#field9  .slice { fill: #0000ff; }
#field10 .slice { fill: #8000ff; }
#field11 .slice { fill: #ff00ff; }
#field12 .slice { fill: #ff0080; }
END_CSS

sub histogram {
    my ($data, %opts) = @_;
    my @data   = @$data;
    my @fields;

    my $total = sum @data;

    # some default values that should be overridden!
    my $pie_radius = 100;
    my $pie_padding = 10;
    my $pie_diameter = $pie_radius * 2;
    my $width  = $pie_diameter + $pie_padding * 2;
    my $height = $pie_diameter + $pie_padding * 2;

    my ($center_x, $center_y) = ($pie_radius + $pie_padding) x 2;

    my $svg = qq[<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">\n];
    $svg   .= qq[<svg width="$width" height="$height" viewBox="0 0 $width $height" xmlns="http://www.w3.org/2000/svg">\n];
    $svg   .= qq[<style type="text/css">\n];
    $svg   .= $default_svg_pie_css;
    $svg   .= qq[</style>\n];
    $svg   .= qq[<circle cx="$center_x" cy="$center_y" r="$pie_radius" id="pie"/>\n];

    my $angle = 0;
    my $last_x = sprintf '%.3f', $center_x + $pie_radius * cos $angle;
    my $last_y = sprintf '%.3f', $center_y + $pie_radius * sin $angle;
    for my $i (0 .. $#data) {
        my $field = $fields[$i];
        my $datum = $data[$i];
        my $ratio = $datum / $total;

        $angle += $ratio * 2 * PI;
        $angle /=2 if ($ratio == 1); #if angle is 360, make it 180 (see hack below)
        my $to_x = sprintf '%.3f', $center_x + $pie_radius * cos $angle;
        my $to_y = sprintf '%.3f', $center_y + $pie_radius * sin $angle;

        $svg .= qq[<g class="field" id="field@{[ $i + 1 ]}">\n];
            
        $svg .= qq[    <path d="];
        $svg .= qq[ M$last_x $last_y ];
        # kind of hacky: if the angle is 360, draw 180 degrees of the circle, then draw the other 180 degrees
        # breaks in firefox otherwise
        if ($ratio == 1) {
            $svg .= qq[ A$pie_radius $pie_radius 0 1,1 $to_x $to_y ];
            $svg .= qq[ A$pie_radius $pie_radius 0 1,1 $last_x $last_y ];
        } else {
            $svg .= qq[ A$pie_radius $pie_radius 0 @{[ $ratio > 0.5 ? 1 : 0 ]},1 $to_x $to_y ];
        }
        $svg .= qq[ L$center_x $center_y ];
        $svg .= qq[ Z ];
        $svg .= qq[" class="slice"/>\n];
        $svg .= qq[</g>\n];

        $last_x = $to_x;
        $last_y = $to_y;
    }

    $svg .= qq[ </svg> ];

    return $svg;
}

=head1 AUTHOR

Maintainer: Alex "Eevee" Munroe (C<veekun@veekun.com>)

See the included F<AUTHORS> file for a full list of contributers.

=head1 LICENSE

See the included F<LICENSE> file.

=cut

1;