File Coverage

blib/lib/Math/Bezier.pm

Criterion	Covered	Total	%
statement	62	62	100.0
branch	13	14	92.8
condition			n/a
subroutine	9	9	100.0
pod	0	3	0.0
total	84	88	95.4

#========================================================================
# Math::Bezier
#
# Module for the solution of Bezier curves based on the algorithm
# presented by Robert D. Miller in Graphics Gems V, "Quick and Simple
# Bezier Curve Drawing".
#
# Andy Wardley
#
# Copyright (C) 2000 Andy Wardley.  All Rights Reserved.
#
# This module is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
#========================================================================

package Math::Bezier;

use strict;
use vars qw( $VERSION );

$VERSION = '0.01';

use constant X  => 0;
use constant Y  => 1;
use constant CX => 2;
use constant CY => 3;


#------------------------------------------------------------------------
# new($x1, $y1, $x2, $y2, ..., $xn, $yn)
#
# Constructor method to create a new Bezier curve form.
#------------------------------------------------------------------------

sub new {
    my $class = shift;
    my @points = ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_;
    my $size = scalar @points;
    my @ctrl;

    die "invalid control points, expects (x1, y1, x2, y2, ..., xn, yn)\n"
	if $size % 2;

    while (@points) {
	push(@ctrl, [ splice(@points, 0, 2) ]);
    }
    $size = scalar @ctrl;

    my $n = $size - 1;
    my $choose;

    for (my $k = 0; $k <= $n; $k++) {
	if ($k == 0) {
	    $choose = 1;
	}
	elsif ($k == 1) {
	    $choose = $n;
	}
	else {
	    $choose *= ($n - $k + 1) / $k;
	}
	$ctrl[$k]->[CX] = $ctrl[$k]->[X] * $choose;
	$ctrl[$k]->[CY] = $ctrl[$k]->[Y] * $choose;
    }

    bless \@ctrl, $class;
}


#------------------------------------------------------------------------
# point($theta)
#
# Calculate (x, y) point on curve at position $theta (in the range 0 - 1)
# along the curve.  Returns a list ($x, $y) or reference to a list
# [$x, $y] when called in list or scalar context respectively.
#------------------------------------------------------------------------

sub point {
    my ($self, $t) = @_;
    my $size = scalar @$self;
    my (@points, $point);

    my $n = $size - 1;
    my $u = $t;

    push(@points, [ $self->[0]->[CX], $self->[0]->[CY] ]);

    for (my $k = 1; $k <= $n; $k++) {
	push(@points, [ $self->[$k]->[CX] * $u, $self->[$k]->[CY] * $u ]);
	$u *= $t;
    }

    $point = [ @{ $points[$n] } ];
    my $t1 = 1 - $t;
    my $tt = $t1;

    for (my $k = $n - 1; $k >= 0; $k--) {
	$point->[X] += $points[$k]->[X] * $tt;
	$point->[Y] += $points[$k]->[Y] * $tt;
	$tt = $tt * $t1;
    }

    return wantarray ? (@$point) : $point;
}


#------------------------------------------------------------------------
# curve($npoints)
#
# Sample curve at $npoints points.  Returns a list or reference to a list
# of (x, y) points along the curve, when called in list or scalar context
# respectively.
#------------------------------------------------------------------------

sub curve {
    my ($self, $npoints) = @_;
    $npoints = 20 unless defined $npoints;
    my @points;
    $npoints--;
    foreach (my $t = 0; $t <= $npoints; $t++) {
	push(@points, ($self->point($t / $npoints)));
    }
    return wantarray ? (@points) : \@points;
}

1;

__END__