File Coverage

blib/lib/Math/CatmullRom.pm
Criterion Covered Total %
statement 26 57 45.6
branch 4 14 28.5
condition n/a
subroutine 5 8 62.5
pod 0 6 0.0
total 35 85 41.1


line stmt bran cond sub pod time code
1             ###########################################################################
2             #
3             # Math::CatmullRom
4             #
5             # $Id: CatmullRom.pm,v 1.1.1.1 2003/08/31 16:53:16 wiggly Exp $
6             #
7             # $Author: wiggly $
8             #
9             # $Revision: 1.1.1.1 $
10             #
11             ###########################################################################
12              
13             package Math::CatmullRom;
14              
15 1     1   14222 use strict;
  1         2  
  1         28  
16              
17 1     1   867 use Data::Dumper;
  1         11204  
  1         772  
18              
19             our $VERSION = '0.00';
20              
21              
22             ###########################################################################
23             #
24             # new
25             #
26             ###########################################################################
27             sub new
28             {
29 3     3 0 539 my $class = shift;
30              
31             # control points
32 3         6 my @p = @_;
33            
34 3         5 my $self = {};
35              
36 3         5 $self = bless $self, $class;
37              
38 3         9 $self->control_points( @p );
39              
40 1         5 $self->plot_all( 0 );
41              
42 1         5 return $self;
43             }
44              
45              
46             ###########################################################################
47             #
48             # control_points
49             #
50             ###########################################################################
51             sub control_points
52             {
53 3     3 0 4 my $self = shift;
54              
55 3         5 my @p = @_;
56              
57             # make sure we have enough points
58 3 100       11 if( ( scalar( @p ) / 2 ) < 4 )
59             {
60 2         16 die "passed too few control points, minimum is 4 pairs.\n";
61             }
62            
63             # make sure we have an even amount of points
64 1 50       5 if( scalar( @p ) % 2 )
65             {
66 0         0 die "passed odd number of control points.\n";
67             }
68            
69 1         5 $self->{'p'} = \@p;
70              
71             # pre-calculate some useful values
72 1         5 $self->{'np'} = scalar( @p ) / 2;
73 1         3 $self->{'nl'} = $self->{'np'} - 3;
74              
75             #print STDERR "NP : " . $self->{'np'} . "\n";
76             #print STDERR "NL : " . $self->{'nl'} . "\n";
77            
78 1         4 return 1;
79             }
80              
81              
82             ###########################################################################
83             #
84             # plot_all
85             #
86             ###########################################################################
87             sub plot_all
88             {
89 1     1 0 2 my $self = shift;
90              
91 1 50       4 my $all = shift
92             or 1;
93              
94 1         3 $self->{'plot_all'} = $all;
95              
96 1         2 return 1;
97             }
98              
99              
100             ###########################################################################
101             #
102             # point
103             #
104             ###########################################################################
105             sub point
106             {
107 0     0 0   my $self = shift;
108              
109 0           my $theta = shift;
110              
111 0           my @p = ();
112              
113 0           my ( $segment, $ps, $pf );
114              
115             #print STDERR "TH : $theta\n";
116              
117             # figure out where along the total curve we are
118 0           $theta = $theta * $self->{'nl'};
119              
120             #print STDERR "TH : $theta\n";
121              
122             # figure out which segment we are plotting for
123 0           $segment = int( $theta );
124              
125             # calculate theta within segment
126 0           $theta = $theta - $segment;
127              
128             #print STDERR "TH : $theta\n";
129              
130 0           $ps = $segment * 2;
131              
132 0           $pf = ( ( $segment + 3 ) * 2 ) + 1;
133              
134             #print STDERR "PS : $ps\n";
135             #print STDERR "PF : $pf\n";
136            
137             #print STDERR "POINTS : " . join( ',', ( @{$self->{'p'}}[ $ps .. $pf ] ) ) . "\n";
138              
139             #print STDERR "DUMP : " . Dumper( ( @{$self->{'p'}}[ $ps .. $pf ] ) ) . "\n";
140              
141 0           push @p, catmull_rom( $theta, ( @{$self->{'p'}}[ $ps .. $pf ] ) );
  0            
142              
143 0 0         return wantarray ? @p : \@p;
144             }
145              
146              
147             ###########################################################################
148             #
149             # curve
150             #
151             ###########################################################################
152             sub curve
153             {
154 0     0 0   my $self = shift;
155            
156 0           my $num = shift;
157              
158 0 0         my $per_segment = shift
159             or 0;
160              
161             # list of points on curve
162 0           my @p = ();
163            
164             # if we want to plot per-segemnt then we multiply our number of required
165             # points by the number of segments in our line
166 0 0         if( $per_segment )
167             {
168 0           $num = $num * $self->{'nl'};
169             }
170            
171             # figure out what our theta increment is
172 0           my $increment = 1 / $num;
173              
174 0           my ( $point, $theta );
175            
176 0           $theta = 0;
177            
178             # plot every point and push it onto our return array
179 0           for( $point = 0; $point < $num; $point++ )
180             {
181 0           $theta = $point * $increment;
182 0           push @p, $self->point( $theta );
183             }
184 0           push @p, $self->point( 1.0 );
185              
186             # return as an array or reference depending on context
187 0 0         return wantarray ? @p : \@p;
188             }
189              
190              
191             ###########################################################################
192             #
193             # catmull_rom
194             #
195             ###########################################################################
196             sub catmull_rom
197             {
198 0     0 0   my ( $t, $x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4 ) = @_;
199              
200 0           my $t2 = $t * $t;
201 0           my $t3 = $t2 * $t;
202              
203             return (
204 0           ( 0.5
205             * ( ( - $x1 + 3 * $x2 -3 * $x3 + $x4 ) * $t3
206             + ( 2 * $x1 -5 * $x2 + 4 * $x3 - $x4 ) * $t2
207             + ( -$x1 + $x3 ) * $t
208             + 2 * $x2 ) )
209             ,
210             ( 0.5
211             * ( ( - $y1 + 3 * $y2 -3 * $y3 + $y4 ) * $t3
212             + ( 2 * $y1 -5 * $y2 + 4 * $y3 - $y4 ) * $t2
213             + ( -$y1 + $y3 ) * $t
214             + 2 * $y2 ) )
215             );
216              
217             # return 0.5
218             # * ( ( - $p1 + 3 * $p2 -3 * $p3 + $p4 ) * $t * $t * $t
219             # + ( 2 * $p1 -5 * $p2 + 4 * $p3 - $p4 ) * $t * $t
220             # + ( -$p1 + $p3 ) * $t
221             # + 2 * $p2 );
222             }
223              
224              
225             ###########################################################################
226             1;
227              
228             =pod
229              
230             =head1 NAME
231              
232             Math::CatmullRom - Calculate Catmull-Rom splines
233              
234             =head1 SYNOPSIS
235              
236             use Math::CatmullRom;
237              
238             # create curve passing through list of control points
239             my $curve = new Math::CatmullRom( $x1, $y1, $x2, $y2, ..., $xn, $yn );
240              
241             # or pass reference to list of control points
242             my $curve = new Math::CatmullRom( [ $x1, $y1, $x2, $y2, ..., $xn, $yn ] );
243              
244             # determine (x, y) at point along curve, range 0.0 -> 1.0
245             my ($x, $y) = $curve->point( 0.5 );
246              
247             # returns list ref in scalar context
248             my $xy = $curve->point( 0.5 );
249              
250             # return list of 20 (x, y) points along curve
251             my @curve = $curve->curve( 20 );
252              
253             # returns list ref in scalar context
254             my $curve = $curve->curve( 20 );
255              
256             # include start and finish points by adding false data points
257             $curve->plot_all;
258              
259             =head1 DESCRIPTION
260              
261             This module provides an algorithm to generate plots for Catmull-Rom splines.
262              
263             A Catmull-Rom spline can be considered a special type of Bezier curve that
264             guarantees that the curve will cross every control point starting at the
265             second point and terminating at the penultimate one. For this reason the
266             minimum number of control points is 4.
267              
268             To plot a curve where you have a set of points but want the curve to be
269             drawn through the start and finish points you can tell the module to plot
270             all of the points. In this case it assumes that there are two extra points,
271             prior to the start point with the same values as the start point and one
272             prior to the finish point with the same values as the finish point. This is
273             really just a convenience function for certain kinds of plot.
274              
275             A new Catmull-Rom spline is created using the new() constructor, passing a
276             list of control points.
277              
278             use Math::CatmullRom;
279              
280             # create curve passing through list of control points
281             my @control = ( $x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4 );
282             my $spline = new Math::CatmullRom( @control );
283              
284             Alternatively, a reference to a list of control points may be passed.
285              
286             # or pass reference to list of control points
287             my $spline = new Math::CatmullRom( \@control );
288              
289             The point( $theta ) method can be called on the object, passing a value in
290             the range 0.0 to 1.0 which represents the distance along the spline. When
291             called in list context, the method returns the x and y coordinates of that
292             point on the curve.
293              
294             my ( $x, $y ) = $curve->plot( 0.75 );
295             print "X : $x\nY : $y\n";
296              
297             When called in a scalar context, it returns a reference to a list containing
298             the X and Y coordinates.
299              
300             my $point = $curve->plot( 0.75 );
301             print "X : $point->[0]\nY : $point->[1]\n";
302              
303             The curve( $n, $per_segment ) method can be used to return a set of points
304             sampled along the length of the curve (i.e. in the range 0.0 <= $theta <=
305             1.0).
306              
307             The parameter indicates the number of sample points required. The method
308             returns a list of ($x1, $y1, $x2, $y2, ..., $xn, $yn) points when called in
309             list context, or a reference to such an array when called in scalar context.
310              
311             The $per_segment parameter determines whether $n points total will be plotted
312             or $n points between every point, defaulting to $n points total.
313              
314             my @points = $curve->curve( 10, 1 );
315              
316             while( @points )
317             {
318             my ( $x, $y ) = splice( @points, 0, 2 );
319             print "X : $x\nY : $y\n";
320             }
321              
322             my $points = $curve->curve( 50 );
323              
324             while( @$points )
325             {
326             my ( $x, $y ) = splice( @$points, 0, 2 );
327             print "X : $x\nY : $y\n";
328             }
329              
330             =head1 TODO
331              
332             Test, test, test.
333              
334             =head1 BUGS
335              
336             None known so far. Please report any and all to Nigel Rantor >
337              
338             =head1 SUPPORT / WARRANTY
339              
340             This module is free software. IT COMES WITHOUT WARRANTY OF ANY KIND.
341              
342             =head1 LICENSE
343              
344             The Math::CatmullRom module is Copyright (c) 2003 Nigel Rantor. England. All
345             rights reserved.
346              
347             You may distribute under the terms of either the GNU General Public License
348             or the Artistic License, as specified in the Perl README file.
349              
350             =head1 AUTHORS
351              
352             Nigel Rantor >
353              
354             =head1 SEE ALSO
355              
356             L.
357              
358             =cut