File Coverage

blib/lib/Physics/Springs.pm

Criterion	Covered	Total	%
statement	43	43	100.0
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod	1	1	100.0
total	52	52	100.0

package Physics::Springs;

use 5.006;
use strict;
use warnings;

our $VERSION = '1.01';

use Carp;
use Physics::Particles;
use Sub::Assert;

use base 'Physics::Particles';


sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;

	my $self = $class->SUPER::new();
	$self->{_PhSprings_springs} = [];
	return $self;
}

assert
	pre     => '@PARAM == 1',
	post    => '@RETURN == 1',
	context => 'novoid',
	action  => 'croak',
	sub     => 'new';

sub add_spring {
	my $self   = shift;
	my %args   = @_;
	my $spring = {};
	my $k      = $args{k};
	my $p1     = $args{p1};
	my $p2     = $args{p2};
	my $l      = $args{l};

	defined($k) && defined($p1) && defined($p2)
		or croak("You need to supply several named arguments.");

	# default to being relaxed
	if (not defined $l) {
		my $dist = sqrt(
			( ($self->{p}[$p1]{x} - $self->{p}[$p2]{x}) )**2 +
			( ($self->{p}[$p1]{y} - $self->{p}[$p2]{y}) )**2 +
			( ($self->{p}[$p1]{z} - $self->{p}[$p2]{z}) )**2
		);
		$l = abs($dist);
	}

	$spring->{k}   = $k;
	$spring->{p1}  = $p1;
	$spring->{p2}  = $p2;
	$spring->{len} = $l;

	push @{$self->{_PhSprings_springs}}, $spring;
	return $#{$self->{_PhSprings_springs}};
}

assert
	pre     => '@PARAM >= 9',
	post    => '$VOID or @RETURN == 1 && $RETURN >= 0',
	action  => 'croak',
	sub     => 'add_spring';

sub iterate_step {
	my $self      = shift;
	my @params    = @_;
	my $time_diff = $params[0];
	foreach my $spring (@{$self->{_PhSprings_springs}}) {
		my $p1 = $self->{p}[$spring->{p1}];
		my $p2 = $self->{p}[$spring->{p2}];
		my $l  = $spring->{len};
		my $k  = $spring->{k};

		my $dist =  sqrt(
			( ($p1->{x} - $p2->{x}) )**2 +
			( ($p1->{y} - $p2->{y}) )**2 +
			( ($p1->{z} - $p2->{z}) )**2
		);

		my $force1 = $k * ($dist-$l);
		my $force2 = -$force1;

		my $dx = ($p2->{x} - $p1->{x}) / $dist;
		my $dy = ($p2->{y} - $p1->{y}) / $dist;
		my $dz = ($p2->{z} - $p1->{z}) / $dist;

		$p1->{_fx} += $force1 * $dx;
		$p1->{_fy} += $force1 * $dy;
		$p1->{_fz} += $force1 * $dz;

		$p2->{_fx} += $force2 * $dx;
		$p2->{_fy} += $force2 * $dy;
		$p2->{_fz} += $force2 * $dz;
	}

	$self->SUPER::iterate_step(@params);
}

1;
__END__