laforge
/
gen_ladder
1
0
Fork 0
Code Pull Requests Releases Activity
gen_ladder/GD/Arrow.pm

302 lines
8.0 KiB
Perl
Raw Permalink Blame History

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
View Git Blame Copy Permalink