File Coverage

blib/lib/Math/Geometry.pm
Criterion Covered Total %
statement 45 74 60.8
branch 0 2 0.0
condition 2 2 100.0
subroutine 9 13 69.2
pod 8 10 80.0
total 64 101 63.3


line stmt bran cond sub pod time code
1             #
2             # Filename : Math/Geometry.pm
3             # Description : General Geometry maths functions
4             # Author : Greg McCarroll (greg@mccarroll.org.uk)
5             # Date Created : 22/10/99
6             #
7              
8             =head1 NAME
9              
10             Math::Geometry - Geometry related functions
11              
12             =head1 SYNOPSIS
13              
14             use Math::Geometry;
15              
16             @P2=rotx(@P1,$angle);
17             @P3=rotx(@P1,$angle);
18             @N =triangle_normal(@P1,@P2,@P3);
19             @ZP=zplane_project(@P1,$d);
20              
21              
22             =head1 NOTES
23              
24             This is about to get a massive overhaul, but first im adding tests,
25             lots of lovely lovely tests.
26              
27             Currently for zplane_project onto a plane with normal of the z axis and z=0,
28             the function returns the orthographic projections as opposed to a perspective
29             projection. I'm currently looking into how to properly handle z=0 and will
30             update it shortly.
31              
32             =head1 DESCRIPTION
33              
34             This package implements classic geometry methods. It should be considered alpha
35             software and any feedback at all is greatly appreciated. The following methods
36             are available:
37              
38             =head2 vector_product.
39              
40             Also known as the cross product, given two vectors in Geometry space, the
41             vector_product of the two vectors, is a vector which is perpendicular
42             to the plane of AB with length equal to the length of A multiplied
43             by the length of B, multiplied by the sin of @, where @ is the angle
44             between the two vectors.
45              
46             =head2 triangle_normal
47              
48             Given a triangle ABC that defines a plane P. This function will return
49             a vector N, which is a normal to the plane P.
50              
51             ($Nx,$Ny,$Nz) =
52             triangle_normal(($Ax,$Ay,$Az),($Bx,$By,$Bz),($Cx,$Cy,$Cz));
53              
54             =head2 zplane_project
55              
56             Project a point in Geometry space onto a plane with the z-axis as the normal,
57             at a distance d from z=0.
58              
59             ($x2,$y2,$z2) = zplane_project ($x1,$y1,$z1,$d);
60              
61             =head2 rotx
62              
63             Rotate about the x axis r radians.
64              
65             ($x2,$y2,$z2) = rotx ($x1,$y1,$z1,$r);
66              
67             =head2 roty
68              
69             Rotate about the y axis r radians.
70              
71             ($x2,$y2,$z2) = roty ($x1,$y1,$z1,$r);
72              
73             =head2 rotz
74              
75             Rotate about the z axis r radians.
76              
77             ($x2,$y2,$z2) = rotz ($x1,$y1,$z1,$r);
78              
79             =head2 deg2rad
80              
81             Convert degree's to radians.
82              
83             =head2 rad2deg
84              
85             Convert radians to degree's.
86              
87             =head2 pi
88              
89             Returns an approximate value of Pi, the code has been cribed from Pg146, Programming Perl
90             2nd Ed.
91              
92             =head1 EXAMPLE
93              
94             use Math::Geometry;
95              
96             =head1 AUTHOR
97              
98             Greg McCarroll
99             - http://www.mccarroll.org.uk/~gem/
100              
101             =head1 COPYRIGHT
102              
103             Copyright 2006 by Greg McCarroll
104              
105             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
106              
107             See http://www.perl.com/perl/misc/Artistic.html
108              
109             =cut
110              
111             package Math::Geometry;
112              
113 1     1   28457 use strict;
  1         2  
  1         40  
114 1     1   5 use warnings;
  1         2  
  1         66  
115              
116             require Exporter;
117             our @ISA='Exporter';
118             our @EXPORT = qw/zplane_project triangle_normal rotx roty rotz rad2deg deg2rad pi/;
119              
120 1     1   947 use Math::Matrix;
  1         7141  
  1         1296  
121              
122             our $VERSION='0.04';
123              
124             sub version {
125 0     0 0 0 return "Math::Geometry $VERSION";
126             }
127              
128              
129             sub vector_product {
130 0     0 0 0 my($a,$b,$c,$d,$e,$f)=@_;
131 0         0 return($b*$f-$c*$e,$c*$d-$a*$f,$a*$e-$b*$d);
132             }
133              
134             sub triangle_normal {
135 0     0 1 0 my(($ax,$ay,$az),($bx,$by,$bz),($cx,$cy,$cz))=@_;
136 0         0 my(@AB)=($bx-$ax,$by-$ay,$bz-$az);
137 0         0 my(@AC)=($cx-$ax,$cy-$ay,$cz-$az);
138 0         0 return(vector_product(@AB,@AC));
139             }
140              
141             sub zplane_project {
142 0     0 1 0 my($x,$y,$z,$d)=@_;
143 0         0 my($w);
144 0         0 my($xp,$yp,$zp);
145 0 0       0 if ($d == 0) {
146 0         0 my($trans)=new Math::Matrix ([ 1, 0, 0, 0],
147             [ 0, 1, 0, 0],
148             [ 0, 0, 0, 0],
149             [ 0, 0, 0, 1]);
150 0         0 my($orig) =new Math::Matrix ([ $x],
151             [ $y],
152             [ $z],
153             [ 1]);
154 0         0 my($prod) =$trans->multiply($orig);
155 0         0 $x=$prod->[0][0];
156 0         0 $y=$prod->[1][0];
157 0         0 $z=$prod->[2][0];
158 0         0 $w=$prod->[3][0];
159             } else {
160 0         0 my($trans)=new Math::Matrix ([ 1, 0, 0, 0],
161             [ 0, 1, 0, 0],
162             [ 0, 0, 1, 0],
163             [ 0, 0, 1/$d, 0]);
164 0         0 my($orig) =new Math::Matrix ([ $x],
165             [ $y],
166             [ $z],
167             [ 1]);
168 0         0 my($prod) =$trans->multiply($orig);
169 0         0 $x=$prod->[0][0];
170 0         0 $y=$prod->[1][0];
171 0         0 $z=$prod->[2][0];
172 0         0 $w=$prod->[3][0];
173 0         0 $x=$x/$w;
174 0         0 $y=$y/$w;
175 0         0 $z=$z/$w;
176             }
177 0         0 return ($x,$y,$z);
178             }
179              
180              
181             sub rotx {
182 3     3 1 6 my($x,$y,$z,$rot)=@_;
183 3         8 my($cosr)=cos $rot;
184 3         9 my($sinr)=sin $rot;
185 3         25 my($trans)=new Math::Matrix ([ 1, 0, 0, 0],
186             [ 0, $cosr,-1*$sinr, 0],
187             [ 0, $sinr, $cosr, 0],
188             [ 0, 0, 0, 1]);
189              
190 3         96 my($orig) =new Math::Matrix ([ $x],
191             [ $y],
192             [ $z],
193             [ 1]);
194              
195 3         85 my($prod) =$trans->multiply($orig);
196 3         314 $x=$prod->[0][0];
197 3         7 $y=$prod->[1][0];
198 3         6 $z=$prod->[2][0];
199 3         21 return ($x,$y,$z);
200             }
201              
202             sub roty {
203 3     3 1 8 my($x,$y,$z,$rot)=@_;
204 3         7 my($cosr)=cos $rot;
205 3         9 my($sinr)=sin $rot;
206 3         22 my($trans)=new Math::Matrix ([ $cosr, 0, $sinr, 0],
207             [ 0, 1, 0, 0],
208             [-1*$sinr, 0, $cosr, 0],
209             [ 0, 0, 0, 1]);
210              
211 3         168 my($orig) =new Math::Matrix ([ $x],
212             [ $y],
213             [ $z],
214             [ 1]);
215              
216 3         85 my($prod) =$trans->multiply($orig);
217 3         335 $x=$prod->[0][0];
218 3         5 $y=$prod->[1][0];
219 3         7 $z=$prod->[2][0];
220 3         20 return ($x,$y,$z);
221             }
222              
223             sub rotz {
224 3     3 1 7 my($x,$y,$z,$rot)=@_;
225 3         31 my($cosr)=cos $rot;
226 3         28 my($sinr)=sin $rot;
227 3         43 my($trans)=new Math::Matrix ([ $cosr,-1*$sinr, 0, 0],
228             [ $sinr, $cosr, 0, 0],
229             [ 0, 0, 1, 0],
230             [ 0, 0, 0, 1]);
231              
232 3         123 my($orig) =new Math::Matrix ([ $x],
233             [ $y],
234             [ $z],
235             [ 1]);
236              
237 3         95 my($prod) =$trans->multiply($orig);
238 3         422 $x=$prod->[0][0];
239 3         6 $y=$prod->[1][0];
240 3         6 $z=$prod->[2][0];
241 3         20 return ($x,$y,$z);
242             }
243              
244              
245             sub deg2rad ($) {
246 2     2 1 5 my($deg)=@_;
247 2         33 return ($deg*pi())/180;
248             }
249              
250             sub rad2deg ($) {
251 2     2 1 5 my($rad)=@_;
252 2         6 return ($rad*180)/pi();
253             }
254             {
255             my($PI);
256             sub pi() {
257 17   100 17 1 3160 $PI ||= atan2(1,1)*4;
258 17         76 return $PI;
259             }
260             }
261              
262             1;
263              
264              
265              
266              
267              
268              
269              
270              
271              
272