view release on metacpan or  search on metacpan

lib/Mail/Thread/Arc.pm  view on Meta::CPAN

=cut

sub render {
    my $self = shift;
    my $root = shift;

    # extract just the containers with messages
    my @messages;
    $root->iterate_down(
        sub {
            my $container = shift;
            push @messages, $container if $container->message;
        } );

    # sort on date
    @messages = sort {
        $self->date_of( $a ) <=> $self->date_of( $b )
    } @messages;

    $self->messages( \@messages );

    $self->width( ( @messages + 1 ) * $self->message_radius * 3 );
    $self->height( $self->maximum_arc_height * 2 + $self->message_radius * 6 );
    $self->svg( SVG->new( width => $self->width, height => $self->height, onload => "init(evt)" ) );

    {
        # assign the numbers needed to compute X
        my $i;
        $self->message_offsets( { map { $_ => ++$i } @messages } );
    }
    $self->svg->script->CDATA( $self->javascript_chunk );

    $self->draw_arc( $_->parent, $_ ) for @messages;
    $self->draw_message( $_ ) for @messages;

    return $self->svg;
}


=head2 draw_message( $message )

Draw the message on the SVG canvas.

=cut

sub draw_message {
    my ($self, $message) = @_;

    my $i = $self->message_offsets->{$message} - 1;

    my $link = $self->make_link($message);
    my $root = $self->svg;
    $root = $root->anchor( -href=> $link ) if defined $link;

    my $group = $root->group(
        id          => "road$i",
        onmouseover => "set_group_color( $i, 'blue' )",
        $self->message_style( $message ),
       );

    $group->title->cdata( $message->header('from') );
    $group->desc->cdata( "Date: " . $message->header('date') );

    $group->circle(
        cx => $self->message_x( $message ),
        cy => $self->message_y,
        r  => $self->message_radius,
       );
    
}


=head2 make_link( $message )

Return an URI based on the message. By default returns 
undef meaning that that the message is not a link.

However if this module is subclassed then a meaningful
URI can be returned where appropriate.

=cut

sub make_link {
    my ($self, $message) = @_;
    return;
}


=head2 draw_arc( $from, $to )

draws an arc between two messages

=cut

sub draw_arc {
    my ($self, $from, $to) = @_;

    return unless $from;

    my $distance = $self->message_x( $to ) - $self->message_x( $from );
    my $radius = $distance/ 2;

    my $top = $self->thread_generation( $to ) % 2;
    my $x = $self->message_x( $from );
    my $y = $self->message_y + ( $top ? -$self->message_radius : $self->message_radius);

    my %offsets = %{ $self->message_offsets };

    my $path;
    if ($radius > $self->maximum_arc_height) { # uh oh - trickyness
        my $max = $self->maximum_arc_height;
        # to Y - the relative part of the first curve
        my $toy = $top ? -$max : $max;
        my $toy2 = -$toy;
        my $x2 = $self->message_x( $to ) - $max;
        my $y2 = $y + $toy;

        $path = join(' ',
                     "M $x,$y",                        #start the path
                     "a$max,$max 0 0,$top $max,$toy",  # arc up
                     "L $x2,$y2",                      # line across
                     "a$max,$max 0 0,$top $max,$toy2", # arc down