File Coverage

blib/lib/SecondLife/Rotation.pm

Criterion	Covered	Total	%
statement	70	82	85.3
branch	16	20	80.0
condition			n/a
subroutine	17	20	85.0
pod	4	8	50.0
total	107	130	82.3

package SecondLife::Rotation;
{
  $SecondLife::Rotation::VERSION = '0.900';
}
# ABSTRACT: Second Life's rotations (quarterions with a non-standard representation)
use strict;
use warnings;
use overload
    '""' => "stringify";
use Regexp::Common qw/ RE_num_real /;
use Scalar::Util qw( blessed );

use parent qw/Math::Quaternion/;

use constant X_SLOT => 1;
use constant Y_SLOT => 2;
use constant Z_SLOT => 3;
use constant S_SLOT => 0;

sub x {
    my $self = shift;
    if ( @_ ) {
        $self->[X_SLOT] = $_[0];
        return $self;
    }
    else {
        return $self->[X_SLOT];
    }
}

sub y {
    my $self = shift;
    if ( @_ ) {
        $self->[Y_SLOT] = $_[0];
        return $self;
    }
    else {
        return $self->[Y_SLOT];
    }
}

sub z {
    my $self = shift;
    if ( @_ ) {
        $self->[Z_SLOT] = $_[0];
        return $self;
    }
    else {
        return $self->[Z_SLOT];
    }
}

sub s {
    my $self = shift;
    if ( @_ ) {
        $self->[S_SLOT] = $_[0];
        return $self;
    }
    else {
        return $self->[S_SLOT];
    }
}

sub new {
    my $class = shift;
    if ( @_ == 1 ) {
        my ($rot) = @_;
        if ( blessed $rot ) {
            unless ( $rot->isa("Math::Quaternion") ) {
                require Carp;
                Carp::croak("We only understand quaternion's as provided by Math::Quaternion");
            }
            return $class->new( x=> $rot->[X_SLOT], y=>$rot->[Y_SLOT], z=>$rot->[Z_SLOT], s=>$rot->[S_SLOT] );
        }
        elsif (ref $rot eq 'HASH') {
            return $class->new( Math::Quaternion->new($rot) );
        }
        else {
            my $num = RE_num_real();
            if ( $rot =~ /^ [(<] \s* ($num), \s* ($num), \s* ($num), \s* ($num) \s* [)>] $/xo ) {
                return $class->SUPER::new( $4, $1, $2, $3 );
            }
            else {
                require Carp;
                Carp::croak( "Could not parse a rotation from $rot" );
            }
        }
    }
    else {
        my %args = @_;
        my $self = $class->SUPER::new();
        foreach (keys %args) {
            $self->$_( $args{$_} );
        }
        return bless $self, $class;
    }
}

sub stringify {
    my $self = shift;
    return "<".join(", ",$self->x,$self->y,$self->z,$self->s).">";
}

sub rotate_vector {
    my $self = shift;
    my( $vector ) = @_;
    my( $x, $y, $z) = $self->SUPER::rotate_vector( $vector->x, $vector->y, $vector->z );
    return SecondLife::Vector->new( x=>$x, y=>$y, z=>$z );
}


sub rotation { bless Math::Quaternion::rotation(@_); }

## Wrap methods:
foreach (qw( unit conjugate inverse normalize multiply dot plus minus power negate scale slerp )) {
    my $super = "SUPER::conjugate";
    no strict 'refs';
    *$_ = sub {
        my $self = shift;
        my $class = ref($self) ? ref($self) : $self;
        return bless $self->$super(@_), $class;
    };
}

1;


__END__