302 lines
8.0 KiB
Perl
302 lines
8.0 KiB
Perl
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__
|
|
|
|
=head1 NAME
|
|
|
|
GD::Arrow - draw arrows using GD
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use GD;
|
|
use GD::Arrow;
|
|
|
|
my $width = 8;
|
|
my ($x1, $y1) = (100, 10);
|
|
my ($x2, $y2) = (100, 190);
|
|
my ($x3, $y3) = (10, 30);
|
|
my ($x4, $y4) = (190, 75);
|
|
|
|
my $arrow = GD::Arrow::Full->new(
|
|
-X1 => $x1,
|
|
-Y1 => $y1,
|
|
-X2 => $x2,
|
|
-Y2 => $y2,
|
|
-WIDTH => $width,
|
|
);
|
|
|
|
my $image = GD::Image->new(200, 200);
|
|
my $white = $image->colorAllocate(255, 255, 255);
|
|
my $black = $image->colorAllocate(0, 0, 0);
|
|
my $blue = $image->colorAllocate(0, 0, 255);
|
|
my $yellow = $image->colorAllocate(255, 255, 0);
|
|
$image->transparent($white);
|
|
|
|
$image->filledPolygon($arrow,$blue);
|
|
$image->polygon($arrow,$black);
|
|
|
|
my $half_arrow_1 = GD::Arrow::LeftHalf->new(
|
|
-X1 => $x3,
|
|
-Y1 => $y3,
|
|
-X2 => $x4,
|
|
-Y2 => $y4,
|
|
-WIDTH => $width,
|
|
);
|
|
|
|
my $half_arrow_2 = GD::Arrow::LeftHalf->new(
|
|
-X1 => $x4,
|
|
-Y1 => $y4,
|
|
-X2 => $x3,
|
|
-Y2 => $y3,
|
|
-WIDTH => $width
|
|
);
|
|
|
|
$image->filledPolygon($half_arrow_1,$blue);
|
|
$image->polygon($half_arrow_1,$black);
|
|
|
|
$image->filledPolygon($half_arrow_2,$yellow);
|
|
$image->polygon($half_arrow_2,$black);
|
|
|
|
open IMAGE, "> image.png" or die $!;
|
|
binmode(IMAGE, ":raw");
|
|
print IMAGE $image->png;
|
|
close IMAGE;
|
|
|
|
exit(0);
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This is a subclass of GD::Polygon used to draw an arrow between two vertices.
|
|
|
|
GD::Arrow::Full draws a full arrow between two verticies.
|
|
|
|
|\
|
|
+----------------------+ \
|
|
(X2, Y2) * * (X1, Y1)
|
|
+----------------------+ /
|
|
|/
|
|
|
|
GD::Arrow::RightHalf draws a half arrow between two verticies.
|
|
|
|
(X2, Y2) *-------------------------* (X1, Y1)
|
|
+----------------------+ /
|
|
|/
|
|
|
|
GD::Arrow::LeftHalf draws a half arrow between two verticies.
|
|
|
|
|\
|
|
+----------------------+ \
|
|
(X2, Y2) *-------------------------* (X1, Y1)
|
|
|
|
=head1 SEE ALSO
|
|
|
|
GD::Polygon
|
|
|
|
=head1 CREDITS
|
|
|
|
The equations used to determine the critical verticies to represent a GD::Arrow was based on Hideki Ono's makefeedmap software. Makefeedmap can be found at http://www.ono.org/software/makefeedmap/.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Todd Caine, E<lt>todd@pobox.comE<gt>
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
Copyright 2004 by Todd Caine
|
|
|
|
This library is free software; you can redistribute it and/or modify
|
|
it under the same terms as Perl itself.
|
|
|
|
=cut
|
|
|