# Author:  Chao-Kuei Hung
# For more info, including license, please see doc/index.html

package Vector;
# Mathematical Vector

use strict;
use Carp;
use vars qw(@ISA);
@ISA = qw();

my (%generated);

BEGIN {

    my ($functemplate) = q{
	sub {
	    my ($self, $that) = @_;
	    my ($r) = bless [], ref($self);
	    my ($i);
	    if (ref $that) {
		croak "dimension mismatch (", $#$self+1, " vs ",
		    $#$that+1, ") in <OP>" unless $#$self == $#$that;
		for ($i=0; $i<=$#$self; ++$i) {
		    $r->[$i] = $self->[$i] <OP> $that->[$i];
		}
	    } else {
		for ($i=0; $i<=$#$self; ++$i) {
		    $r->[$i] = $self->[$i] <OP> $that;
		}
	    }
	    return $r;
	}
    };

    my (%functab) = (
	add => '+',
	sbt => '-',
	mul => '*',
	div => '/',
    );

    my ($name, $op);
    while (($name, $op) = each %functab) {
	my ($t) = $functemplate;
	$t =~ s/<OP>/$op/g;
	$generated{$name} = eval $t;
    }
}

# see perldoc overload, especially the "MAGIC AUTOGENERATION" section
use overload
    '='  => 'clone',
    '""' => 'stringify',
    '+'  => $generated{add},
    '-'  => $generated{sbt},
#    '*'  => $generated{mul},
#    '/'  => $generated{div},
    'fallback' => undef
;

sub pw_mul { return $generated{mul}->(@_); }
sub pw_div { return $generated{div}->(@_); }


sub new {
    my ($class, @data) = @_;
    $class = ref($class) if ref($class);
#    if (ref $data[0] eq "Vector") {
    if (ref $data[0]) {
	return clone(undef, $data[0], "");
    } else {
	return bless [@data], $class;
    }
}

# Copy constructor is very tricky. It is _not_ called until
# just before a mutator is applied to one of the reference
# variables sharing the same copy. See perldoc overload,
# especially the "Copy Constructor" section.
sub clone {
    my ($a, $b, $switch) = @_;
    print STDERR "Vector::clone : switch is undef!\n"
	unless defined $switch;
    # print STDERR $switch ? "+" : "-"; # always prints "-"
    return $switch ? bless([@$a],"Vector") : bless([@$b],"Vector");
}

sub stringify {
    my ($self) = @_;
    my ($r) = sprintf "[ %8g", $self->[0];
    foreach (@{$self}[1..$#$self]) {
	$r .= sprintf(", %8g", $_);
    }
    return $r . " ]";
}

sub dot {
# dot product
    my ($t) = $_[0]->pw_mul($_[1]);
    my ($s, $i);
    for ($i=0; $i<=$#$t; ++$i) {
	$s += $t->[$i];
    }
    return $s;
}

sub norm {
    my ($self) = @_;
    return sqrt($self->dot($self));
}

sub angle_cos {
    my ($self, $b) = @_;
    return $self->dot($b)/$self->norm()/$b->norm();
}

sub cob {
# change of basis
    my ($self, $b) = @_;
    die unless ($#$b == $#$self and $#$b == $#{$b->[0]});
    my ($r) = Vector->new($self);
    map { $_ = 0; } @$r;
    my ($i);
    for ($i=0; $i<=$#$self; ++$i) {
	$r += $b->[$i]->pw_mul($self->[$i]);
    }
    return $r;
}

### 2-d functions ###

#sub slope {
#    my ($self) = @_;
#    return $self->[1]/$self->[0];
#}

sub angle {
    my ($self) = @_;
    return atan2($self->[1], $self->[0]);
}

sub orient2d {
    my ($a, $b, $c) = @_;
    $b -= $a; $c -= $a;
    return $b->[0]*$c->[1] - $b->[1]*$c->[0];
}

sub makebasis {
    my ($self) = @_;
    my ($l) = $self->norm();
    my ($c, $s) = ($self->[0]/$l, $self->[1]/$l);
    return [Vector->new($c,-$s),Vector->new($s,$c)];
}

### 3-d functions ###

sub cross {
# cross product
    my ($self, $other) = @_;
    return Vector->new(
	$self->[1]*$other->[2]-$self->[2]*$other->[1],
	$self->[2]*$other->[0]-$self->[0]*$other->[2],
	$self->[0]*$other->[1]-$self->[1]*$other->[0],
    );
}

sub rotate_around {
# rotate $self around $axis by $th
    my ($self, $axis, $th) = @_;

    my ($x, $r, $p);
    $r = $axis->norm();
    return $self if $r < 1e-5;
    $x = $axis->pw_div($r);
    $r = $x->pw_mul($self->dot($x));
    $p = $self - $r;
    return $r + $p->pw_mul(cos($th)) + $x->cross($p)->pw_mul(sin($th));
}

if ($0 =~ /Vector.pm$/) {
# being tested as a stand-alone program, so run test code.
    my ($x) = Vector->new(4,-3);
    my ($y) = Vector->new(5,12);
    my ($z);

    print $x+$y, ",", $x-$y, ",",
	$x->orient2d(Vector->new(0,0), $y), "\n";
    $z = $x;
    $z += $y;
    $y = $y->pw_div(2);
    print $x, ",", $y, ",", $z, ",", $x->pw_mul(3), "\n";

    # 3d tests
    $x = Vector->new(1,1,0);
    $y = Vector->new(1,1,1);
    $z = $x->rotate_around($y, atan2(1,1)*8/3);
    print $z, "\n";
    # should print [0, 1, 1]
}

1;

