File Coverage

blib/lib/GD/Arrow.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package GD::Arrow;
# $Id: Arrow.pm,v 1.7 2004/10/25 17:22:27 tcaine Exp $

use strict;
use warnings;
use vars qw( $VERSION @ISA );
use GD;

$VERSION = '0.01';
@ISA = qw( GD::Polygon );

sub x1    { shift->{X1}    }
sub y1    { shift->{Y1}    }
sub x2    { shift->{X2}    }
sub y2    { shift->{Y2}    }
sub width { shift->{WIDTH} }

package GD::Arrow::Full;

use strict;
use warnings;
use vars qw( $VERSION @ISA );
use Carp;
use GD;

$VERSION = '0.01';
@ISA = qw( GD::Arrow );

sub new {
    my $class = shift;
    my %arg = @_;
    my ($x1, $y1, $x2, $y2, $width);
    my $self = $class->SUPER::new();

    foreach ( keys %arg ) {
        if    (/^-?X1$/i)    { $self->{X1} = $x1 = $arg{$_} }
        elsif (/^-?Y1$/i)    { $self->{Y1} = $y1 = $arg{$_} }
        elsif (/^-?X2$/i)    { $self->{X2} = $x2 = $arg{$_} }
        elsif (/^-?Y2$/i)    { $self->{Y2} = $y2 = $arg{$_} }
        elsif (/^-?WIDTH$/i) { $self->{WIDTH} = $width = $arg{$_} }
    }

    $self->{WIDTH} = $width = 6 if !defined($self->{WIDTH});

    croak "" . __PACKAGE__ . "->new() requires 4 named parameters"
        if !defined($self->{X1}) ||
           !defined($self->{Y1}) ||
           !defined($self->{X2}) ||
           !defined($self->{Y2});

    my $double_width = $width * 2;
    my $theta = atan2($y1-$y2,$x1-$x2);

    $self->addPt(
        sprintf('%.0f', $x2+$width*sin($theta)),
        sprintf('%.0f', $y2-$width*cos($theta))
    );
    $self->addPt(
        sprintf('%.0f', $x2-$width*sin($theta)),
        sprintf('%.0f', $y2+$width*cos($theta))
    );
    $self->addPt(
        sprintf('%.0f', $x1-$width*sin($theta)-$double_width*cos($theta)),
        sprintf('%.0f', $y1-$double_width*sin($theta)+$width*cos($theta))
    );
    $self->addPt(
        sprintf('%.0f', $x1-$double_width*sin($theta)-$double_width*cos($theta)),
        sprintf('%.0f', $y1-$double_width*sin($theta)+$double_width*cos($theta))
    );
    $self->addPt($x1,$y1);
    $self->addPt(
        sprintf('%.0f', $x1+$double_width*(sin($theta)-cos($theta))),
        sprintf('%.0f', $y1+$double_width*(-sin($theta)-cos($theta)))
    );
    $self->addPt(
        sprintf('%.0f', $x1+$width*sin($theta)-$double_width*cos($theta)),
        sprintf('%.0f', $y1-$double_width*sin($theta)-$width*cos($theta))
    );

    return $self;
}

package GD::Arrow::LeftHalf;

use strict;
use warnings;
use vars qw( $VERSION @ISA );
use Carp;
use GD;

$VERSION = '0.01';
@ISA = qw( GD::Arrow );

sub new {
    my $class = shift;
    my %arg = @_;
    my ($x1, $y1, $x2, $y2, $width);
    my $self = $class->SUPER::new();

    foreach ( keys %arg ) {
        if    (/^-?X1$/i)    { $self->{X1} = $x1 = $arg{$_} }
        elsif (/^-?Y1$/i)    { $self->{Y1} = $y1 = $arg{$_} }
        elsif (/^-?X2$/i)    { $self->{X2} = $x2 = $arg{$_} }
        elsif (/^-?Y2$/i)    { $self->{Y2} = $y2 = $arg{$_} }
        elsif (/^-?WIDTH$/i) { $self->{WIDTH} = $width = $arg{$_} }
    }

    $self->{WIDTH} = $width = 6 if !defined($self->{WIDTH});

    croak "" . __PACKAGE__ . "->new() requires 4 named parameters"
        if !defined($self->{X1}) ||
           !defined($self->{Y1}) ||
           !defined($self->{X2}) ||
           !defined($self->{Y2});

    my $double_width = $width * 2;
    my $theta = atan2($y1-$y2,$x1-$x2);

    $self->addPt($x2, $y2);
    $self->addPt(
        sprintf('%.0f', $x2+$width*sin($theta)),
        sprintf('%.0f', $y2-$width*cos($theta))
    );
    $self->addPt(
        sprintf('%.0f', $x1+$width*sin($theta)-$double_width*cos($theta)),
        sprintf('%.0f', $y1-$double_width*sin($theta)-$width*cos($theta))
    );
    $self->addPt(
        sprintf('%.0f', $x1+$double_width*(sin($theta)-cos($theta))),
        sprintf('%.0f', $y1+$double_width*(-sin($theta)-cos($theta)))
    );
    $self->addPt($x1,$y1);

    return $self;
}

package GD::Arrow::RightHalf;

use strict;
use warnings;
use vars qw( $VERSION @ISA );
use Carp;
use GD;

$VERSION = '0.01';
@ISA = qw( GD::Arrow );

sub new {
    my $class = shift;
    my %arg = @_;
    my ($x1, $y1, $x2, $y2, $width);
    my $self = $class->SUPER::new();

    foreach ( keys %arg ) {
        if    (/^-?X1$/i)    { $self->{X1} = $x1 = $arg{$_} }
        elsif (/^-?Y1$/i)    { $self->{Y1} = $y1 = $arg{$_} }
        elsif (/^-?X2$/i)    { $self->{X2} = $x2 = $arg{$_} }
        elsif (/^-?Y2$/i)    { $self->{Y2} = $y2 = $arg{$_} }
        elsif (/^-?WIDTH$/i) { $self->{WIDTH} = $width = $arg{$_} }
    }

    $self->{WIDTH} = $width = 6 if !defined($self->{WIDTH});

    croak "" . __PACKAGE__ . "->new() requires 4 named parameters"
        if !defined($self->{X1}) ||
           !defined($self->{Y1}) ||
           !defined($self->{X2}) ||
           !defined($self->{Y2});

    my $double_width = $width * 2;
    my $theta = atan2($y1-$y2,$x1-$x2);

    $self->addPt($x2, $y2);
    $self->addPt(
        sprintf('%.0f', $x2-$width*sin($theta)),
        sprintf('%.0f', $y2+$width*cos($theta))
    );
    $self->addPt(
        sprintf('%.0f', $x1-$width*sin($theta)-$double_width*cos($theta)),
        sprintf('%.0f', $y1-$double_width*sin($theta)+$width*cos($theta))
    );
    $self->addPt(
        sprintf('%.0f', $x1-$double_width*sin($theta)-$double_width*cos($theta)),
        sprintf('%.0f', $y1-$double_width*sin($theta)+$double_width*cos($theta))
    );
    $self->addPt($x1,$y1);

    return $self;
}


1;
__END__