File Coverage

blib/lib/Imager/TimelineDiagram.pm

Criterion	Covered	Total	%
statement	25	96	26.0
branch	1	20	5.0
condition	0	8	0.0
subroutine	8	13	61.5
pod	3	4	75.0
total	37	141	26.2

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__