package Imager::TimelineDiagram;

use 5.00503;
use strict;
use vars qw($VERSION);
use Imager;
use Imager::Fill;
use Imager::Color;
use Carp;

$VERSION = '0.15';

# create object
sub new {
    my ($class,@args) = @_;
    if (scalar(@args)%2 != 0) {
        carp("Invalid arguments. No in name/value pair format.");
        return(undef);
    }

    my %hashObject = (
        imageHeight => 440,
        imageWidth => 440,

        gridWidth => 401,
        gridHeight => 401,
        gridSpacing => 10,
        gridXOffset => 20,
        gridYOffset => 10,
        gridColor => Imager::Color->new(200,200,200),

        dataColor => Imager::Color->new(255,100,100),
        dataFormat => '%0.2f', # sprintf() format string
        dataLabelSide => 'right',
        showArrowheads => 1,

        labelColor => Imager::Color->new(0,0,0),
        labelSize => 12,
        labelFont => Imager::Font->new(file => 'ImUgly.ttf'),
    );

    my %hash = @args;
    for (keys %hash) {
        $hashObject{$_} = $hash{$_};
    }

    if (! defined($hashObject{'labelFont'})) {
        carp("Failed to load labelFont specified.");
        return(undef);
    }

    $hashObject{_image} = Imager->new(xsize => $hashObject{'imageWidth'},
                                      ysize => $hashObject{'imageHeight'},
                                      channels => 4);

    if (! defined($hashObject{'_image'})) {
        carp("Failed to create new Imager object : $!");
        return(undef);
    }

    my $self = bless(\%hashObject,$class||__PACKAGE__);
}

# set list of milestones.
sub set_milestones {
    my ($self,@milestones) = @_;
    $self->{_legend} = [@milestones];
} 

# and AoA of :
#   @array = (
#     ['processFrom','processTo','time'],
#     .
#     .
#     .
#   )
# time being units from start of timeline
sub add_points {
    my ($self,@aoa) = @_;
    $self->{_data} = [@aoa];
} 

# write out to disk/stdout
# but first, this is where the magic happens
sub write {
    my ($self,$file) = @_;
    $self->_draw_grid();
    $self->_draw_data();
    $self->{'_image'}->write(file => $file);
}



######## internal functions #######

# draw the grid and labels
sub _draw_grid { 
    my ($self) = @_;
    my $image = $self->{_image};

    my @v_lines;
    my @points = @{ $self->{_legend} };

    # for every $gridSpacing pixes across, draw a vertical line
    for (my $i=$self->{'gridXOffset'}; $i <= $self->{'gridWidth'} ;$i += $self->{'gridSpacing'}) {
        $image->line(color => $self->{'gridColor'}, x1 => $i, y1 => $self->{'gridYOffset'},
                                          x2 => $i, y2 => $self->{'gridYOffset'}+$self->{'gridHeight'});
        push(@v_lines,$i);
    }

    # for every $gridSpacing pixes across, draw a horizontal line
    for (my $i=$self->{'gridYOffset'}; $i < $self->{'gridYOffset'}+$self->{'gridHeight'} ;$i += $self->{'gridSpacing'}) {
        $image->line(color => $self->{'gridColor'}, x1 => $self->{'gridXOffset'}, y1 => $i,
                                          x2 => $self->{'gridWidth'}, y2 => $i);
    }

    # Logic Time:
    # There are scalar(@v_lines) rows in the grid.
    # There are scalar(@points) connection point.
    $self->{'px_per_point'} = int( scalar(@v_lines) / (scalar(@points)-1) ) * $self->{'gridSpacing'};
    my $current_px = $self->{'gridXOffset'};
    for (my $pn=0;$pn < scalar(@points);$pn++) {
        if ($current_px > $v_lines[-1]) {
            $current_px = $v_lines[-1];
        }
        $image->box(color => Imager::Color->new(0,0,0),
                xmin => $current_px-1, ymin => $self->{'gridYOffset'},
                xmax => $current_px+1, ymax => $self->{'gridHeight'}+$self->{'gridYOffset'},
                filled => 1
                );
        my @bbox = $self->{'labelFont'}->bounding_box(string => $points[$pn]);
        $image->string(font => $self->{'labelFont'},
                       text => $points[$pn],
                       x => $current_px-(($bbox[2]-$bbox[0])/2),   # current line/2
                       y => $self->{'gridYOffset'}+$self->{'gridHeight'}+($bbox[3]),                # grid + letter height
                       size => $self->{'labelSize'},
                       color => $self->{'labelColor'}
                      );
        $self->{_label_to_x_offset}{$points[$pn]} = $current_px;
        $current_px += $self->{'px_per_point'};
    }

    $image->string(
                  font => $self->{'labelFont'},
                  size => $self->{'labelSize'},
                  color => $self->{'labelColor'},
                  text => sprintf($self->{dataFormat},0),
                  x => $self->{'gridWidth'},
                  y => $self->{'gridYOffset'},
                  );
    $image->string(
                  font => $self->{'labelFont'},
                  size => $self->{'labelSize'},
                  color => $self->{'labelColor'},
                  text => sprintf($self->{dataFormat},($self->{'maxTime'} || $self->{_data}[-1][2])),
                  x => $self->{'gridWidth'},
                  y => $self->{'gridHeight'}+$self->{'gridYOffset'},
                  );
}

sub _draw_data {
    my ($self) = @_;
    if (! $self->{'px_per_point'}) {
        $self->_draw_grid();
    }
    my $image = $self->{'_image'};

    # ok, more logic :
    #   the grid is $self->{'gridHeight'} pixes high
    #   the highest scale needed is $self->{'maxTime'} || $self->{_data}[-1][2]
    #   there is no negative time, the scale begins at 0
    #   so ...
    #
    #   gridHeight/maxTime pixels per second

    my $px_per_sec = ($self->{'gridHeight'}/($self->{'maxTime'} || $self->{_data}[-1][2]));
    foreach my $aref (@{ $self->{_data} }) {
        my $from = $aref->[0];
        my $to   = $aref->[1];
        my $time = $aref->[2];
 
        my $fromX = $self->{_label_to_x_offset}{$from};
        my $toX   = $self->{_label_to_x_offset}{$to};
        my $timeY = $px_per_sec * $time;
       
        #print "[$fromX,$timeY] -> [$toX,$timeY]\n";
        $image->line(color => $self->{'dataColor'},
                     x1 => $fromX , y1 => $timeY,
                     x2 => $toX ,   y2 => $timeY,
                    );

        my $dlX;
        my @bbox = $self->{'labelFont'}->bounding_box(string => sprintf($self->{'dataFormat'},$time));
        my $dlY = $timeY;
        if ($self->{'dataLabelSide'} eq 'left') {
            $dlX = ( $fromX < $toX ? $fromX : $toX ) - 5 - ($bbox[2]-$bbox[0]);
        } else {
            $dlX = ( $fromX > $toX ? $fromX : $toX ) + 5;
        }
        $image->string(font => $self->{'labelFont'},
                       size => $self->{'labelSize'},
                       color => $self->{'labelColor'},
                       text => sprintf($self->{'dataFormat'},$time),
                       x => $dlX,
                       y => $dlY,
                      );

        if ($self->{'showArrowheads'}) {
            my ($ahBkX,$ahBkY1,$ahBkY2);
            if ($toX > $fromX) {
                $ahBkX = $toX-3;
            } else {
                $ahBkX = $toX+3;
            }
            $ahBkY1 = $timeY-2;
            $ahBkY2 = $timeY+2;
            # ploygon's are anti-aliased ... and that core's my Imager :(
            #$image->polygon(x => [$toX,$ahBkX,$ahBkX],y => [$timeY,$ahBkY1,$ahBkY2],color => $self->{'dataColor'});
            $image->polyline(x => [$toX,$ahBkX,$ahBkX,$toX],y => [$timeY,$ahBkY1,$ahBkY2,$timeY],color => $self->{'dataColor'});
        }
    }
}

1;
__END__

=head1 NAME

Imager::TimelineDiagram - Perl extension for creating Timeline Diagrams (designed to show system interaction over time)

=head1 SYNOPSIS

  use Imager::TimelineDiagram;
  use Imager::Font;

  my $tg = Imager::TimelineDiagram->new(
                                      #maxTime => 10,
                                      #dataLabelSide => 'left',
                                      labelFont => Imager::Font->new(file => 't/ImUgly.ttf'),
                                     );

  $tg->set_milestones(qw(A B C D E));

  my @points = (
     # From, To, AtTime
     ['A','B',1.0],
     ['B','C',2.0],
     ['C','D',3.3],
     ['D','C',4.3],
     ['C','A',5.0],
  );

  $tg->add_points(@points);

  $tg->write('foo.png');

=head1 ABSTRACT

  Module for creating Timeline Diagrams.

=head1 DESCRIPTION

Module for creating Timeline Diagrams. 

=head2 OPTIONS

=over 6
=item new

  Create a new object. Returns undef on error. Takes the following options (listed with defaults) :
    imageHeight => 440,
    imageWidth => 440,

    gridWidth => 401,
    gridHeight => 401,
    gridSpacing => 10,
    gridXOffset => 20,
    gridYOffset => 10,
    gridColor => Imager::Color->new(200,200,200),  # grey

    dataColor => Imager::Color->new(255,100,100),  # red-ish
    dataFormat => '%0.2f', # sprintf() format string
    dataLabelSide => 'right',
    showArrowheads => 1,

    labelColor => Imager::Color->new(0,0,0),
    labelSize => 12,
    labelFont => Imager::Font->new(file => 'ImUgly.ttf'),

=item set_milestones

  Set the names of the stop-lines on the diagram. In the original usage these represented processes and the module was used to show the message processing time.

=item add_points

  Add the data. This method takes an array of arrays with data in the form of :

   @array = (
     ['processFrom','processTo','time'],
     .
     .
     .
   )

  Where the 'time' is the amount of time since the beginig of the timeline. (So, it should be greater than all previoud values)

=item write

  This method takes a single argument of file name and outputs the image. The format of the image is decided by the file extention using Imager's internal logic.

=back

=head2 EXPORT

None by default.

=head2 TODO

If you have the time to spend, feel free to work on these and send me patches.

=over 6

=item  * Add ability to pass DateTime objects in add_points

=item  * Make the module auto-populate the milestones if not provided

=item  * Provide API access to Imager object

=item  * Add more formatting options.

=back

=head1 HISTORY

=over 8

=item 0.15

Documentation added (pod).

=item 0.10

Original version


=back


=head1 SEE ALSO

perl, Imager

=head1 AUTHOR

Matt Sanford <mzsanford@cpan.org>

=head1 COPYRIGHT AND LICENSE

Copyright 2004 by Matt Sanford

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut