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

Imager-TimelineDiagram documentation Contained in the Imager-TimelineDiagram distribution.

Index

Code Index:

NAME

Top

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

SYNOPSIS

Top

  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');

ABSTRACT

Top

  Module for creating Timeline Diagrams.

DESCRIPTION

Top

Module for creating Timeline Diagrams.

OPTIONS

  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'),
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.
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)
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.

EXPORT

None by default.

TODO

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

* Add ability to pass DateTime objects in add_points
* Make the module auto-populate the milestones if not provided
* Provide API access to Imager object
* Add more formatting options.

HISTORY

Top

0.15

Documentation added (pod).

0.10

Original version

SEE ALSO

Top

perl, Imager

AUTHOR

Top

Matt Sanford <mzsanford@cpan.org>

COPYRIGHT AND LICENSE

Top

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.

Imager-TimelineDiagram documentation Contained in the Imager-TimelineDiagram distribution. 
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__