r3784 - in /packages/libmath-vec-perl: ./ branches/
branches/upstream/
branches/upstream/current/ branches/upstream/current/lib/
branches/upstream/current/lib/Math/ branches/upstream/current/t/ tags/
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Thu Sep 14 22:26:35 UTC 2006
Author: gregoa-guest
Date: Thu Sep 14 22:26:35 2006
New Revision: 3784
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=3784
Log:
[svn-inject] Installing original source of libmath-vec-perl
Added:
packages/libmath-vec-perl/
packages/libmath-vec-perl/branches/
packages/libmath-vec-perl/branches/upstream/
packages/libmath-vec-perl/branches/upstream/current/
packages/libmath-vec-perl/branches/upstream/current/Build.PL
packages/libmath-vec-perl/branches/upstream/current/Changes
packages/libmath-vec-perl/branches/upstream/current/MANIFEST
packages/libmath-vec-perl/branches/upstream/current/META.yml
packages/libmath-vec-perl/branches/upstream/current/Makefile.PL
packages/libmath-vec-perl/branches/upstream/current/README
packages/libmath-vec-perl/branches/upstream/current/lib/
packages/libmath-vec-perl/branches/upstream/current/lib/Math/
packages/libmath-vec-perl/branches/upstream/current/lib/Math/Vec.pm
packages/libmath-vec-perl/branches/upstream/current/t/
packages/libmath-vec-perl/branches/upstream/current/t/00-load.t
packages/libmath-vec-perl/branches/upstream/current/t/01-pod-coverage.t
packages/libmath-vec-perl/branches/upstream/current/t/02-pod.t
packages/libmath-vec-perl/branches/upstream/current/t/03-test.t
packages/libmath-vec-perl/tags/
Added: packages/libmath-vec-perl/branches/upstream/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-vec-perl/branches/upstream/current/Build.PL?rev=3784&op=file
==============================================================================
--- packages/libmath-vec-perl/branches/upstream/current/Build.PL (added)
+++ packages/libmath-vec-perl/branches/upstream/current/Build.PL Thu Sep 14 22:26:35 2006
@@ -1,0 +1,23 @@
+
+use strict;
+use warnings;
+use Module::Build;
+my $build_class = 'Module::Build';
+my $custom_build = 'Module::Build::Live';
+eval("require $custom_build;");
+unless($@) {
+ warn "using custom build class: '$custom_build'\n";
+ $build_class = $custom_build;
+}
+
+my $builder = $build_class->new(
+ module_name => 'Math::Vec',
+ license => 'perl',
+ dist_version_from => 'lib/Math/Vec.pm',
+ requires => {
+ 'Test::More' => 0,
+ },
+ add_to_cleanup => [ qw(Math-Vec-* META.yml)],
+);
+
+$builder->create_build_script();
Added: packages/libmath-vec-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-vec-perl/branches/upstream/current/Changes?rev=3784&op=file
==============================================================================
--- packages/libmath-vec-perl/branches/upstream/current/Changes (added)
+++ packages/libmath-vec-perl/branches/upstream/current/Changes Thu Sep 14 22:26:35 2006
@@ -1,0 +1,17 @@
+0.04
+ test 03 workaround for Exporter.pm transient bug
+ Exporter rework
+ fixed nit in compatibility Makefile.PL
+
+0.03
+ Setup to run clean under 'use warnings'.
+ Added overloading and :terse functions.
+ More tests.
+
+0.02
+ Fixed incorrect DotProduct() (thanks to Nao-Yuki Tanabe.)
+ Added length != 0 check to Comp()
+
+
+0.01
+ First Public Release
Added: packages/libmath-vec-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-vec-perl/branches/upstream/current/MANIFEST?rev=3784&op=file
==============================================================================
--- packages/libmath-vec-perl/branches/upstream/current/MANIFEST (added)
+++ packages/libmath-vec-perl/branches/upstream/current/MANIFEST Thu Sep 14 22:26:35 2006
@@ -1,0 +1,11 @@
+Build.PL
+Changes
+MANIFEST
+META.yml # Will be created by "make dist"
+Makefile.PL
+README
+lib/Math/Vec.pm
+t/00-load.t
+t/01-pod-coverage.t
+t/02-pod.t
+t/03-test.t
Added: packages/libmath-vec-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-vec-perl/branches/upstream/current/META.yml?rev=3784&op=file
==============================================================================
--- packages/libmath-vec-perl/branches/upstream/current/META.yml (added)
+++ packages/libmath-vec-perl/branches/upstream/current/META.yml Thu Sep 14 22:26:35 2006
@@ -1,0 +1,18 @@
+---
+name: Math-Vec
+version: 0.04
+author: []
+abstract: Object-Oriented Vector Math Methods in Perl
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+requires:
+ Test::More: 0
+provides:
+ Math::Vec:
+ file: lib/Math/Vec.pm
+ version: 0.04
+generated_by: Module::Build version 0.28
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Added: packages/libmath-vec-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-vec-perl/branches/upstream/current/Makefile.PL?rev=3784&op=file
==============================================================================
--- packages/libmath-vec-perl/branches/upstream/current/Makefile.PL (added)
+++ packages/libmath-vec-perl/branches/upstream/current/Makefile.PL Thu Sep 14 22:26:35 2006
@@ -1,0 +1,29 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+
+ unless (eval "use Module::Build::Compat 0.02; 1" ) {
+ print "This module requires Module::Build to install itself.\n";
+
+ require ExtUtils::MakeMaker;
+ my $yn = ExtUtils::MakeMaker::prompt
+ (' Install Module::Build now from CPAN?', 'y');
+
+ unless ($yn =~ /^y/i) {
+ die " *** Cannot install without Module::Build. Exiting ...\n";
+ }
+
+ require Cwd;
+ require File::Spec;
+ require CPAN;
+
+ # Save this 'cause CPAN will chdir all over the place.
+ my $cwd = Cwd::cwd();
+
+ CPAN::Shell->install('Module::Build::Compat');
+ CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
+ or die "Couldn't install Module::Build, giving up.\n";
+
+ chdir $cwd or die "Cannot chdir() back to $cwd: $!";
+ }
+ eval "use Module::Build::Compat 0.02; 1" or die $@;
+
+ Module::Build::Compat->run_build_pl(args => \@ARGV);
Added: packages/libmath-vec-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-vec-perl/branches/upstream/current/README?rev=3784&op=file
==============================================================================
--- packages/libmath-vec-perl/branches/upstream/current/README (added)
+++ packages/libmath-vec-perl/branches/upstream/current/README Thu Sep 14 22:26:35 2006
@@ -1,0 +1,19 @@
+Math-Vec
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Build.PL
+ ./Build
+ ./Build test
+ ./Build install
+
+
+DOCUMENTATION
+
+After installing, you can find documentation for this module with the perldoc command.
+
+ perldoc Math::Vec
+
+
Added: packages/libmath-vec-perl/branches/upstream/current/lib/Math/Vec.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-vec-perl/branches/upstream/current/lib/Math/Vec.pm?rev=3784&op=file
==============================================================================
--- packages/libmath-vec-perl/branches/upstream/current/lib/Math/Vec.pm (added)
+++ packages/libmath-vec-perl/branches/upstream/current/lib/Math/Vec.pm Thu Sep 14 22:26:35 2006
@@ -1,0 +1,935 @@
+package Math::Vec;
+our $VERSION = '0.04';
+
+=pod
+
+=head1 NAME
+
+Math::Vec - Object-Oriented Vector Math Methods in Perl
+
+=head1 SYNOPSIS
+
+ use Math::Vec;
+ $v = Math::Vec->new(0,1,2);
+
+ or
+
+ use Math::Vec qw(NewVec);
+ $v = NewVec(0,1,2);
+ @res = $v->Cross([1,2.5,0]);
+ $p = NewVec(@res);
+ $q = $p->Dot([0,1,0]);
+
+ or
+
+ use Math::Vec qw(:terse);
+ $v = V(0,1,2);
+ $q = ($v x [1,2.5,0]) * [0,1,0];
+
+=head1 NOTICE
+
+This module is still somewhat incomplete. If a function does nothing,
+there is likely a really good reason. Please have a look at the code
+if you are trying to use this in a production environment.
+
+=head1 AUTHOR
+
+Eric L. Wilhelm <ewilhelm at cpan dot org>
+
+http://scratchcomputing.com
+
+=head1 DESCRIPTION
+
+This module was adapted from Math::Vector, written by Wayne M. Syvinski.
+
+It uses most of the same algorithms, and currently preserves the same
+names as the original functions, though some aliases have been added to
+make the interface more natural (at least to the way I think.)
+
+The "object" for the object oriented calling style is a blessed array
+reference which contains a vector of the form [x,y,z]. Methods will
+typically return a list.
+
+=head1 COPYRIGHT NOTICE
+
+Copyright (C) 2003-2006 Eric Wilhelm
+
+portions Copyright 2003 Wayne M. Syvinski
+
+=head1 NO WARRANTY
+
+Absolutely, positively NO WARRANTY, neither express or implied, is
+offered with this software. You use this software at your own risk.
+In case of loss, neither Wayne M. Syvinski, Eric Wilhelm, nor anyone
+else, owes you anything whatseover. You have been warned.
+
+Note that this includes NO GUARANTEE of MATHEMATICAL CORRECTNESS. If
+you are going to use this code in a production environment, it is YOUR
+RESPONSIBILITY to verify that the methods return the correct values.
+
+=head1 LICENSE
+
+You may use this software under one of the following licenses:
+
+ (1) GNU General Public License
+ (found at http://www.gnu.org/copyleft/gpl.html)
+ (2) Artistic License
+ (found at http://www.perl.com/pub/language/misc/Artistic.html)
+
+=head1 SEE ALSO
+
+ Math::Vector
+
+=cut
+
+########################################################################
+
+use strict;
+use warnings;
+use Carp;
+use Math::Complex;
+
+BEGIN {
+use Exporter;
+*{import} = \&Exporter::import;
+}
+our @EXPORT = ();
+our @EXPORT_OK = qw(
+ NewVec
+ );
+our @terse_exp = qw(
+ V
+ U
+ X
+ Y
+ Z
+ );
+our %EXPORT_TAGS = (
+ terse => [@terse_exp],
+ );
+Exporter::export_ok_tags(keys(%EXPORT_TAGS));
+
+
+########################################################################
+
+=head1 Constructor
+
+=head2 new
+
+Returns a blessed array reference to cartesian point ($x, $y, $z),
+where $z is optional. Note the feed-me-list, get-back-reference syntax
+here. This is the opposite of the rest of the methods for a good
+reason (it allows nesting of function calls.)
+
+The z value is optional, (and so are x and y.) Undefined values are
+silently translated into zeros upon construction.
+
+ $vec = Math::Vec->new($x, $y, $z);
+
+=cut
+sub new {
+ my $caller = shift;
+ my $class = ref($caller) || $caller;
+ my $self = [map({defined($_) ? $_ : 0} @_[0,1,2])];
+ bless($self, $class);
+ return($self);
+} # end subroutine new definition
+########################################################################
+
+=head2 NewVec
+
+This is simply a shortcut to Math::Vec->new($x, $y, $z) for those of
+you who don't want to type so much so often. This also makes it easier
+to nest / chain your function calls. Note that methods will typically
+output lists (e.g. the answer to your question.) While you can simply
+[bracket] the answer to make an array reference, you need that to be
+blessed in order to use the $object->method(@args) syntax. This
+function does that blessing.
+
+This function is exported as an option. To use it, simply use
+Math::Vec qw(NewVec); at the start of your code.
+
+ use Math::Vec qw(NewVec);
+ $vec = NewVec($x, $y, $z);
+ $diff = NewVec($vec->Minus([$ovec->ScalarMult(0.5)]));
+
+=cut
+sub NewVec {
+ return(Math::Vec->new(@_));
+} # end subroutine NewVec definition
+########################################################################
+
+=head1 Terse Functions
+
+These are all one-letter shortcuts which are imported to your namespace
+with the :terse flag.
+
+ use Math::Vec qw(:terse);
+
+=head2 V
+
+This is the same as Math::Vec->new($x,$y,$z).
+
+ $vec = V($x, $y, $z);
+
+=cut
+sub V {
+ return(Math::Vec->new(@_));
+} # end subroutine V definition
+########################################################################
+
+=head2 U
+
+Shortcut to V($x,$y,$z)->UnitVector()
+
+ $unit = U($x, $y, $z);
+
+This will also work if called with a vector object:
+
+ $unit = U($vector);
+
+=cut
+sub U {
+ my $v;
+ if(ref($_[0])) {
+ $v = _vec_check($_[0]);
+ }
+ else {
+ $v = V(@_);
+ }
+ return(V($v->UnitVector()));
+} # end subroutine U definition
+########################################################################
+
+=head2 X
+
+Returns an x-axis unit vector.
+
+ $xvec = X();
+
+=cut
+sub X {
+ V(1,0,0);
+} # end subroutine X definition
+########################################################################
+
+=head2 Y
+
+Returns a y-axis unit vector.
+
+ $yvec = Y();
+
+=cut
+sub Y {
+ V(0,1,0);
+} # end subroutine Y definition
+########################################################################
+
+=head2 Z
+
+Returns a z-axis unit vector.
+
+ $zvec = Z();
+
+=cut
+sub Z {
+ V(0,0,1);
+} # end subroutine Z definition
+########################################################################
+
+=head1 Overloading
+
+Best used with the :terse functions, the Overloading scheme introduces
+an interface which is unique from the Methods interface. Where the
+methods take references and return lists, the overloaded operators will
+return references. This allows vector arithmetic to be chained together
+more easily. Of course, you can easily dereference these with @{$vec}.
+
+The following sections contain equivelant expressions from the longhand
+and terse interfaces, respectively.
+
+=head2 Negation:
+
+ @a = NewVec->(0,1,1)->ScalarMult(-1);
+ @a = @{-V(0,1,1)};
+
+=head2 Stringification:
+
+This also performs concatenation and other string operations.
+
+ print join(", ", 0,1,1), "\n";
+
+ print V(0,1,1), "\n";
+
+ $v = V(0,1,1);
+ print "$v\n";
+ print "$v" . "\n";
+ print $v, "\n";
+
+=head2 Addition:
+
+ @a = NewVec(0,1,1)->Plus([2,2]);
+
+ @a = @{V(0,1,1) + V(2,2)};
+
+ # only one argument needs to be blessed:
+ @a = @{V(0,1,1) + [2,2]};
+
+ # and which one is blessed doesn't matter:
+ @a = @{[0,1,1] + V(2,2)};
+
+=head2 Subtraction:
+
+ @a = NewVec(0,1,1)->Minus([2,2]);
+
+ @a = @{[0,1,1] - V(2,2)};
+
+=head2 Scalar Multiplication:
+
+ @a = NewVec(0,1,1)->ScalarMult(2);
+
+ @a = @{V(0,1,1) * 2};
+
+ @a = @{2 * V(0,1,1)};
+
+=head2 Scalar Division:
+
+ @a = NewVec(0,1,1)->ScalarMult(1/2);
+
+ # order matters!
+ @a = @{V(0,1,1) / 2};
+
+=head2 Cross Product:
+
+ @a = NewVec(0,1,1)->Cross([0,1]);
+
+ @a = @{V(0,1,1) x [0,1]};
+
+ @a = @{[0,1,1] x V(0,1)};
+
+=head2 Dot Product:
+
+Also known as the "Scalar Product".
+
+ $a = NewVec(0,1,1)->Dot([0,1]);
+
+ $a = V(0,1,1) * [0,1];
+
+Note: Not using the '.' operator here makes everything more efficient.
+I know, the * is not a dot, but at least it's a mathematical operator
+(perl does some implied string concatenation somewhere which drove me to
+avoid the dot.)
+
+=head2 Comparison:
+
+The == and != operators will compare vectors for equal direction and
+magnitude. No attempt is made to apply tolerance to this equality.
+
+=head2 Length:
+
+ $a = NewVec(0,1,1)->Length();
+
+ $a = abs(V(0,1,1));
+
+=head2 Vector Projection:
+
+This one is a little different. Where the method is written
+$a->Proj($b) to give the projection of $b onto $a, this reads like you
+would say it (b projected onto a): $b>>$a.
+
+ @a = NewVec(0,1,1)->Proj([0,0,1]);
+
+ @a = @{V(0,0,1)>>[0,1,1]};
+
+=head1 Chaining Operations
+
+The above examples simply show how to go from the method interface to
+the overloaded interface, but where the overloading really shines is in
+chaining multiple operations together. Because the return values from
+the overloaded operators are all references, you dereference them only
+when you are done.
+
+=head2 Unit Vector left of a line
+
+This comes from the CAD::Calc::line_to_rectangle() function.
+
+ use Math::Vec qw(:terse);
+ @line = ([0,1],[1,0]);
+ my ($a, $b) = map({V(@$_)} @line);
+ $unit = U($b - $a);
+ $left = $unit x -Z();
+
+=head2 Length of a cross product
+
+ $length = abs($va x $vb);
+
+=head2 Vectors as coordinate axes
+
+This is useful in drawing eliptical arcs using dxf data.
+
+ $val = 3.14159; # the 'start parameter'
+ @c = (14.15973317961194, 6.29684276451746); # codes 10, 20, 30
+ @e = (6.146127847120538, 0); # codes 11, 21, 31
+ @ep = @{V(@c) + \@e}; # that's the axis endpoint
+ $ux = U(@e); # unit on our x' axis
+ $uy = U($ux x -Z()); # y' is left of x'
+ $center = V(@c);
+ # autodesk gives you this:
+ @pt = ($a * cos($val), $b * sin($val));
+ # but they don't tell you about the major/minor axis issue:
+ @pt = @{$center + $ux * $pt[0] + $uy * $pt[1]};;
+
+=head1 Precedence
+
+The operator precedence is going to be whatever perl wants it to be. I
+have not yet investigated this to see if it matches standard vector
+arithmetic notation. If in doubt, use parentheses.
+
+One item of note here is that the 'x' and '*' operators have the same
+precedence, so the leftmost wins. In the following example, you can get
+away without parentheses if you have the cross-product first.
+
+ # dot product of a cross product:
+ $v1 x $v2 * $v3
+ ($v1 x $v2) * $v3
+
+ # scalar crossed with a vector (illegal!)
+ $v3 * $v1 x $v2
+
+=cut
+
+use overload
+ 'neg' => sub {
+ return(V($_[0]->ScalarMult(-1)));
+ },
+ '""' => sub {
+ return(join(",", @{$_[0]}));
+ },
+ '+' => sub {
+ my ($v, $arg) = @_;
+ $arg = _vec_check($arg);
+ return(V($v->Plus($arg)));
+ },
+ '-' => sub {
+ my ($v, $arg, $flip) = @_;
+ $arg = _vec_check($arg);
+ $flip and (($v, $arg) = ($arg, $v));
+ return(V($v->Minus($arg)));
+ },
+ '*' => sub {
+ my($v, $arg) = @_;
+ ref($arg) and
+ return($v->Dot($arg));
+ return(V($v->ScalarMult($arg)));
+ },
+ '/' => sub {
+ my($v, $arg, $flip) = @_;
+ $flip and croak("cannot divide by vector");
+ $arg or croak("cannot divide vector by zero");
+ return(V($v->ScalarMult(1 / $arg)));
+ },
+ 'x' => sub {
+ my ($v, $arg, $flip) = @_;
+ $arg = _vec_check($arg);
+ $flip and (($v, $arg) = ($arg, $v));
+ return(V($v->Cross($arg)));
+ },
+ '==' => sub {
+ my ($v, $arg) = @_;
+ $arg = _vec_check($arg);
+ for(my $i = 0; $i < 3; $i++) {
+ ($v->[$i] == $arg->[$i]) or return(0);
+ }
+ return(1);
+ },
+ '!=' => sub {
+ my ($v, $arg) = @_;
+ return(! ($v == $arg));
+ },
+ 'abs' => sub {
+ return($_[0]->Length());
+ },
+ '>>' => sub {
+ my ($v, $arg, $flip) = @_;
+ $arg = _vec_check($arg);
+ $flip and (($v, $arg) = ($arg, $v));
+ return(V($arg->Proj($v)));
+ },
+ ;
+
+# Check and return a vector (or array reference turns into a vector.)
+# also serves to initialize Z-coordinate.
+sub _vec_check {
+ my $arg = shift;
+ if(ref($arg)) {
+ if(ref($arg) eq "ARRAY") {
+ $arg = V(@$arg);
+ }
+ else {
+ eval{$arg->isa('Math::Vec')};
+ $@ and
+ croak("cannot use $arg as a vector");
+ }
+ }
+ else {
+ croak("cannot use $arg as a vector");
+ }
+ return($arg);
+} # end subroutine _vec_check definition
+########################################################################
+
+=head1 Methods
+
+The typical theme is that methods require array references and return
+lists. This means that you can choose whether to create an anonymous
+array ref for use in feeding back into another function call, or you
+can simply use the list as-is. Methods which return a scalar or list
+of scalars (in the mathematical sense, not the Perl SV sense) are
+exempt from this theme, but methods which return what could become one
+vector will return it as a list.
+
+If you want to chain calls together, either use the NewVec constructor,
+or enclose the call in square brackets to make an anonymous array out
+of the result.
+
+ my $vec = NewVec(@pt);
+ my $doubled = NewVec($vec->ScalarMult(0.5));
+ my $other = NewVec($vec->Plus([0,2,1], [4,2,3]));
+ my @result = $other->Minus($doubled);
+ $unit = NewVec(NewVec(@result)->UnitVector());
+
+The vector objects are simply blessed array references. This makes for
+a fairly limited amount of manipulation, but vector math is not
+complicated stuff. Hopefully, you can save at least two lines of code
+per calculation using this module.
+
+=head2 Dot
+
+Returns the dot product of $vec 'dot' $othervec.
+
+ $vec->Dot($othervec);
+
+=cut
+sub Dot {
+ my $self = shift;
+ my ($operand) = @_;
+ $operand = _vec_check($operand);
+ my @r = map( {$self->[$_] * $operand->[$_]} 0,1,2);
+ return( $r[0] + $r[1] + $r[2]);
+} # end subroutine Dot definition
+########################################################################
+
+=head2 DotProduct
+
+Alias to Dot()
+
+ $number = $vec->DotProduct($othervec);
+
+=cut
+sub DotProduct {
+ my $self = shift;
+ return($self->Dot(@_));
+} # end subroutine DotProduct definition
+########################################################################
+
+=head2 Cross
+
+Returns $vec x $other_vec
+
+ @list = $vec->Cross($other_vec);
+ # or, to use the result as a vec:
+ $cvec = NewVec($vec->Cross($other_vec));
+
+=cut
+sub Cross {
+ my $a = shift;
+ my $b = shift;
+ $b = _vec_check($b);
+ my $x = (($a->[1] * $b->[2]) - ($a->[2] * $b->[1]));
+ my $y = (($a->[2] * $b->[0]) - ($a->[0] * $b->[2]));
+ my $z = (($a->[0] * $b->[1]) - ($a->[1] * $b->[0]));
+ return($x, $y, $z);
+} # end subroutine Cross definition
+########################################################################
+
+=head2 CrossProduct
+
+Alias to Cross() (should really strip out all of this clunkiness and go
+to operator overloading, but that gets into other hairiness.)
+
+ $vec->CrossProduct();
+
+=cut
+sub CrossProduct {
+ my $self = shift;
+ return($self->Cross(@_));
+} # end subroutine CrossProduct definition
+########################################################################
+
+=head2 Length
+
+Returns the length of $vec
+
+ $length = $vec->Length();
+
+=cut
+sub Length {
+ my Math::Vec $self = shift;
+ my $sum;
+ map( {$sum+=$_**2} @$self );
+ return(sqrt($sum));
+} # end subroutine Length definition
+########################################################################
+
+=head2 Magnitude
+
+ $vec->Magnitude();
+
+=cut
+sub Magnitude {
+ my Math::Vec $self = shift;
+ return($self->Length());
+} # end subroutine Magnitude definition
+########################################################################
+
+=head2 UnitVector
+
+ $vec->UnitVector();
+
+=cut
+sub UnitVector {
+ my Math::Vec $self = shift;
+ my $mag = $self->Length();
+ $mag || croak("zero-length vector (@$self) has no unit vector");
+ return(map({$_ / $mag} @$self) );
+} # end subroutine UnitVector definition
+########################################################################
+
+=head2 ScalarMult
+
+Factors each element of $vec by $factor.
+
+ @new = $vec->ScalarMult($factor);
+
+=cut
+sub ScalarMult {
+ my Math::Vec $self = shift;
+ my($factor) = @_;
+ return(map( {$_ * $factor} @{$self}));
+} # end subroutine ScalarMult definition
+########################################################################
+
+=head2 Minus
+
+Subtracts an arbitrary number of vectors.
+
+ @result = $vec->Minus($other_vec, $another_vec?);
+
+This would be equivelant to:
+
+ @result = $vec->Minus([$other_vec->Plus(@list_of_vectors)]);
+
+=cut
+sub Minus {
+ my Math::Vec $self = shift;
+ my @list = @_;
+ my @result = @$self;
+ foreach my $vec (@list) {
+ @result = map( {$result[$_] - $vec->[$_]} 0..$#$vec);
+ }
+ return(@result);
+} # end subroutine Minus definition
+########################################################################
+
+=head2 VecSub
+
+Alias to Minus()
+
+ $vec->VecSub();
+
+=cut
+sub VecSub {
+ my Math::Vec $self = shift;
+ return($self->Minus(@_));
+} # end subroutine VecSub definition
+########################################################################
+
+=head2 InnerAngle
+
+Returns the acute angle (in radians) in the plane defined by the two
+vectors.
+
+ $vec->InnerAngle($other_vec);
+
+=cut
+sub InnerAngle {
+ my $A = shift;
+ my $B = shift;
+ my $dot_prod = $A->Dot($B);
+ my $m_A = $A->Length();
+ my $m_B = $B->Length();
+ return(acos($dot_prod / ($m_A * $m_B)) );
+} # end subroutine InnerAngle definition
+########################################################################
+
+=head2 DirAngles
+
+ $vec->DirAngles();
+
+=cut
+sub DirAngles {
+ my Math::Vec $self = shift;
+ my @unit = $self->UnitVector();
+ return( map( {acos($_)} @unit) );
+} # end subroutine DirAngles definition
+########################################################################
+
+=head2 Plus
+
+Adds an arbitrary number of vectors.
+
+ @result = $vec->Plus($other_vec, $another_vec);
+
+=cut
+sub Plus {
+ my Math::Vec $self = shift;
+ my @list = @_;
+ my @result = @$self;
+ foreach my $vec (@list) {
+ @result = map( {$result[$_] + $vec->[$_]} 0..$#$vec);
+ }
+ return(@result);
+} # end subroutine Plus definition
+########################################################################
+
+=head2 PlanarAngles
+
+If called in list context, returns the angle of the vector in each of
+the primary planes. If called in scalar context, returns only the
+angle in the xy plane. Angles are returned in radians
+counter-clockwise from the primary axis (the one listed first in the
+pairs below.)
+
+ ($xy_ang, $xz_ang, $yz_ang) = $vec->PlanarAngles();
+
+=cut
+sub PlanarAngles {
+ my $self = shift;
+ my $xy = atan2($self->[1], $self->[0]);
+ wantarray || return($xy);
+ my $xz = atan2($self->[2], $self->[0]);
+ my $yz = atan2($self->[2], $self->[1]);
+ return($xy, $xz, $yz);
+} # end subroutine PlanarAngles definition
+########################################################################
+
+=head2 Ang
+
+A simpler alias to PlanarAngles() which eliminates the concerns about
+context and simply returns the angle in the xy plane.
+
+ $xy_ang = $vec->Ang();
+
+=cut
+sub Ang {
+ my $self = shift;
+ my ($xy) = $self->PlanarAngles();
+ return($xy);
+} # end subroutine Ang definition
+########################################################################
+
+=head2 VecAdd
+
+ $vec->VecAdd();
+
+=cut
+sub VecAdd {
+ my Math::Vec $self = shift;
+ return($self->Plus(@_));
+} # end subroutine VecAdd definition
+########################################################################
+
+=head2 UnitVectorPoints
+
+Returns a unit vector which points from $A to $B.
+
+ $A->UnitVectorPoints($B);
+
+=cut
+sub UnitVectorPoints {
+ my $A = shift;
+ my $B = shift;
+ $B = NewVec(@$B); # because we cannot guarantee that it was blessed
+ return(NewVec($B->Minus($A))->UnitVector());
+} # end subroutine UnitVectorPoints definition
+########################################################################
+
+=head2 InnerAnglePoints
+
+Returns the InnerAngle() between the three points. $Vert is the vertex
+of the points.
+
+ $Vert->InnerAnglePoints($endA, $endB);
+
+=cut
+sub InnerAnglePoints {
+ my $v = shift;
+ my ($A, $B) = @_;
+ my $lead = NewVec($v->UnitVectorPoints($A));
+ my $tail = NewVec($v->UnitVectorPoints($B));
+ return($lead->InnerAngle($tail));
+} # end subroutine InnerAnglePoints definition
+########################################################################
+
+=head2 PlaneUnitNormal
+
+Returns a unit vector normal to the plane described by the three
+points. The sense of this vector is according to the right-hand rule
+and the order of the given points. The $Vert vector is taken as the
+vertex of the three points. e.g. if $Vert is the origin of a
+coordinate system where the x-axis is $A and the y-axis is $B, then the
+return value would be a unit vector along the positive z-axis.
+
+ $Vert->PlaneUnitNormal($A, $B);
+
+=cut
+sub PlaneUnitNormal {
+ my $v = shift;
+ my ($A, $B) = @_;
+ $A = NewVec(@$A);
+ $B = NewVec(@$B);
+ my $lead = NewVec($A->Minus($v));
+ my $tail = NewVec($B->Minus($v));
+ return(NewVec($lead->Cross($tail))->UnitVector);
+} # end subroutine PlaneUnitNormal definition
+########################################################################
+
+=head2 TriAreaPoints
+
+Returns the angle of the triangle formed by the three points.
+
+ $A->TriAreaPoints($B, $C);
+
+=cut
+sub TriAreaPoints {
+ my $A = shift;
+ my ($B, $C) = @_;
+ $B = NewVec(@$B);
+ $C = NewVec(@$C);
+ my $lead = NewVec($A->Minus($B));
+ my $tail = NewVec($A->Minus($C));
+ return(NewVec($lead->Cross($tail))->Length() / 2);
+} # end subroutine TriAreaPoints definition
+########################################################################
+
+=head2 Comp
+
+Returns the scalar projection of $B onto $A (also called the component
+of $B along $A.)
+
+ $A->Comp($B);
+
+=cut
+sub Comp {
+ my $self = shift;
+ my $B = _vec_check(shift);
+ my $length = $self->Length();
+ $length || croak("cannot Comp() vector without length");
+ return($self->Dot($B) / $length);
+} # end subroutine Comp definition
+########################################################################
+
+=head2 Proj
+
+Returns the vector projection of $B onto $A.
+
+ $A->Proj($B);
+
+=cut
+sub Proj {
+ my $self = shift;
+ my $B = shift;
+ return(NewVec($self->UnitVector())->ScalarMult($self->Comp($B)));
+} # end subroutine Proj definition
+########################################################################
+
+=head2 PerpFoot
+
+Returns a point on line $A,$B which is as close to $pt as possible (and
+therefore perpendicular to the line.)
+
+ $pt->PerpFoot($A, $B);
+
+=cut
+sub PerpFoot {
+ my $pt = shift;
+ my ($A, $B) = @_;
+ $pt = NewVec($pt->Minus($A));
+ $B = NewVec(NewVec(@$B)->Minus($A));
+ my $proj = NewVec($B->Proj($pt));
+ return($proj->Plus($A));
+} # end subroutine PerpFoot definition
+########################################################################
+
+=head1 Incomplete Methods
+
+The following have yet to be translated into this interface. They are
+shown here simply because I intended to fully preserve the function
+names from the original Math::Vector module written by Wayne M.
+Syvinski.
+
+=head2 TripleProduct
+
+ $vec->TripleProduct();
+
+=cut
+sub TripleProduct {
+ die("not written");
+} # end subroutine TripleProduct definition
+########################################################################
+
+=head2 IJK
+
+ $vec->IJK();
+
+=cut
+sub IJK {
+ die("not written");
+
+} # end subroutine IJK definition
+########################################################################
+
+=head2 OrdTrip
+
+ $vec->OrdTrip();
+
+=cut
+sub OrdTrip {
+ die("not written");
+
+} # end subroutine OrdTrip definition
+########################################################################
+
+=head2 STV
+
+ $vec->STV();
+
+=cut
+sub STV {
+ die("not written");
+
+} # end subroutine STV definition
+########################################################################
+
+=head2 Equil
+
+ $vec->Equil();
+
+=cut
+sub Equil {
+ die("not written");
+
+} # end subroutine Equil definition
+########################################################################
+
+1;
Added: packages/libmath-vec-perl/branches/upstream/current/t/00-load.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-vec-perl/branches/upstream/current/t/00-load.t?rev=3784&op=file
==============================================================================
--- packages/libmath-vec-perl/branches/upstream/current/t/00-load.t (added)
+++ packages/libmath-vec-perl/branches/upstream/current/t/00-load.t Thu Sep 14 22:26:35 2006
@@ -1,0 +1,7 @@
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok('Math::Vec');
+}
+
+diag( "Testing Math::Vec $Math::Vec::VERSION" );
Added: packages/libmath-vec-perl/branches/upstream/current/t/01-pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-vec-perl/branches/upstream/current/t/01-pod-coverage.t?rev=3784&op=file
==============================================================================
--- packages/libmath-vec-perl/branches/upstream/current/t/01-pod-coverage.t (added)
+++ packages/libmath-vec-perl/branches/upstream/current/t/01-pod-coverage.t Thu Sep 14 22:26:35 2006
@@ -1,0 +1,7 @@
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage"
+ if $@;
+plan skip_all => '$ENV{TEST_POD_COVERAGE} is not set'
+ unless((($ENV{USER} || '') eq 'ewilhelm') or exists($ENV{TEST_POD_COVERAGE}));
+all_pod_coverage_ok();
Added: packages/libmath-vec-perl/branches/upstream/current/t/02-pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-vec-perl/branches/upstream/current/t/02-pod.t?rev=3784&op=file
==============================================================================
--- packages/libmath-vec-perl/branches/upstream/current/t/02-pod.t (added)
+++ packages/libmath-vec-perl/branches/upstream/current/t/02-pod.t Thu Sep 14 22:26:35 2006
@@ -1,0 +1,7 @@
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD"
+ if $@;
+plan skip_all => '$ENV{TEST_POD} is not set'
+ unless((($ENV{USER} || '') eq 'ewilhelm') or exists($ENV{TEST_POD}));
+all_pod_files_ok();
Added: packages/libmath-vec-perl/branches/upstream/current/t/03-test.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-vec-perl/branches/upstream/current/t/03-test.t?rev=3784&op=file
==============================================================================
--- packages/libmath-vec-perl/branches/upstream/current/t/03-test.t (added)
+++ packages/libmath-vec-perl/branches/upstream/current/t/03-test.t Thu Sep 14 22:26:35 2006
@@ -1,0 +1,52 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+use strict;
+use warnings;
+
+use Test::More;
+BEGIN { plan tests => 22 };
+use Math::Vec qw(:terse NewVec);
+ok(1, "require"); # If we made it this far, we're ok.
+
+#########################
+
+my $pt;
+ok( $pt = Math::Vec->new(0,5), 'constructor');
+ok( V($pt->ScalarMult(3)) == [0,15] ,'multiplication');
+# how to test for warnings on 2D vectors?
+ok(scalar(@{V(0,1)}) == 3, 'auto-init');
+my $v = V(1,1);
+ok($v->isa('Math::Vec'), 'constructor');
+ok(V(1,1) == V(1,1), 'comparison');
+ok(V(1,1) != V(1,0), 'comparison');
+ok(abs(V(3,4)) == 5, 'length');
+my $qpi = atan2(1,1);
+my $angs = V(V(1,1,1)->PlanarAngles());
+ok($angs == [($qpi) x 3], 'angles');
+ok(($v - [0,1]) == [1,0], 'subtraction');
+ok($v + [4,5,1] == [5,6,1], 'addition');
+
+ok(X == [1,0,0], 'X-axis');
+ok(Y == [0,1,0], 'Y-axis');
+ok(Z == [0,0,1], 'Z-axis');
+ok(-$v == [-1,-1], 'negation');
+
+# now to check the functional interface
+$v = NewVec(0,1,2);
+my @res = $v->Cross([1,2.5]);
+ok(V(@res) == ($v x [1,2.5]), 'cross product');
+my $p = NewVec(@res);
+my $q = $p->Dot([0,1]);
+ok($q == $p * [0,1], 'dot product');
+my @proj = V(1,0)->Proj([1,1,1]);
+ok(V(@proj) == V(1,0), 'vector projection');
+ok(V(@proj) == V(1,1,1) >> [1,0], 'vector projection');
+
+my $comp = V(1,0)->Comp([1,1,1]);
+ok($comp == 1, 'scalar projection (component)');
+ok($comp == abs(V(1,1,1) >> [1,0]), 'comp == abs(proj)');
+ok(V(1,1,1) x Z() == [1,-1], 'perpendicular');
More information about the Pkg-perl-cvs-commits
mailing list