# 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},
    'neg'=> 'negate',
    '*'  => $generated{mul},
    '/'  => $generated{div},
    'fallback' => undef
;

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

# Different from "Perl Cookbook", chap 13.6, p.461 "cloning objects"
# See Randal Schwartz's "Constructing Objects" at
# http://www.stonehenge.com/merlyn/UnixReview/col52.html
# (search for "three camps")
sub new {
    my ($proto, @data) = @_;
    my ($class) = ref $proto || $proto;
#    if (ref $data[0] eq "Vector") {
    if (ref $proto) {
	return bless [ @$proto ], $class;
    } 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 negate {
    my ($self) = @_;
    return bless [map { -$_ } @$self], ref $self;
}

sub x { return $_[0]->[0]; }
sub y { return $_[0]->[1]; }
sub z { return $_[0]->[2]; }

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) = $self->new();
    map { $_ = 0; } @$r;
    my ($i);
    for ($i=0; $i<=$#$self; ++$i) {
	$r += $b->[$i]->pw_mul($self->[$i]);
    }
    return $r;
}

if ($0 =~ /Vector.pm$/) {
# being tested as a stand-alone program, so run test code.
    my ($p, $q, $r);
    $p = Vector->new(4,-3);
    $q = Vector->new(5,12);
    print $p+$q, ",", $p-$q, "\n";

    $r = $p;
    $r += $q;
    $q = $q->pw_div(2);
    print $p, ",", $q, ",", $r, ",", $p->pw_mul(3), ",", -$p, "\n";

}

1;