view release on metacpan or  search on metacpan

TimelineDiagram.pm  view on Meta::CPAN

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) = @_;