The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package SVG::Graph::Glyph::pictogram;
BEGIN {
  $SVG::Graph::Glyph::pictogram::AUTHORITY = 'cpan:CJFIELDS';
}

our $VERSION = '0.04'; # VERSION

use base SVG::Graph::Glyph;
use strict;
use Data::Dumper;

our @lifts;


sub draw {
    my ( $self, @args ) = @_;

    my ( $x1, $x2, $y1, $y2 ) = ( undef, undef, undef, undef );

    #this will be the width of a bar, we need to calculate the
    #minimum distance between any two values in the data,
    #and use that as the step size.
    my $step = undef;
    my %xcoords = map { $_->x => 1 } $self->group->data;

    ( $x1, $x2 ) = ( undef, undef );
    foreach my $xcoord ( sort { $a <=> $b } keys %xcoords ) {

        $x1 = $xcoord and next unless defined($x1);
        $x2 = $xcoord;

        if ( !defined($step) ) {
            $step = $x2 - $x1;
        }
        else {
            $step = $x2 - $x1 < $step ? $x2 - $x1 : $step;
        }

        $x1 = $x2;
    }

    foreach my $data ( $self->group->data_chunks ) {
        my @newlifts = $self->_glyphs( $step, \@lifts, [ $data->data ] );
        my $i = 0;
        foreach my $newlift (@newlifts) {
            $lifts[$i] += $newlift;
            $i++;
        }
    }
}

sub _glyphs {
    my $self = shift;
    my ( $step, $lifts, $data ) = @_;

    my @ls = ();
    my $l;

    #FIXME this logic is fubar, but it keeps things in proper scale.

    my $yscale = $self->ysize / ( $self->group->ymax );
    my $xscale = $self->xsize / ( scalar(@$data) );

    my $fontsize = int( $self->xsize / ( scalar(@$data) * 0.96 ) );
    foreach my $datum ( sort { $a->x <=> $b->x } @$data ) {

        my $xsc = 1;
        my $ysc = $datum->y * $yscale;
        warn $ysc;
        my $x1 = ( ( $datum->x - 1 ) * $fontsize ) + $self->xoffset;
        my $y1 = $self->ysize + $self->yoffset - ( $self->yoffset / 8 );

        if ( $datum->y > 0 ) {
            $self->canvas->text(
                x => 0,
                y => 0,

#						  'transform'   => "scale($xsc,$ysc), translate(". $x1/$xsc .",". $y1/$ysc .")",
                'transform' => "scale($xsc,$ysc), translate("
                    . $x1 / $xsc . ","
                    . 0 . ")",
                'font-size'   => $fontsize,
                'font-family' => 'Helvetica',
                'text-anchor' => 'right',
                'fill'        => $self->color->{ $datum->label },
            )->cdata( $datum->label );
        }
    }
}


sub color {
    my $self = shift;

    return $self->{'color'} = shift if @_;
    return $self->{'color'};
}

1;

__END__
=pod

=encoding utf-8

=head1 NAME

SVG::Graph::Glyph::pictogram

=head2 draw

 Title   : draw
 Usage   :
 Function:
 Example :
 Returns :
 Args    :

=head2 color

 Title   : color
 Usage   : $obj->color($newval)
 Function:
 Example :
 Returns : value of color (a scalar)
 Args    : on set, new value (a scalar or undef, optional)

=head1 AUTHOR

Chris Fields <cjfields@bioperl.org>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2012 by Chris Fields.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)

=cut