Cube
Cubes in 3d space
PhilipRBrenan@yahoo.com, 2004, Perl License
Synopsis
Example t/cube.t
#_ Cube _______________________________________________________________
# Test cube
# philiprbrenan@yahoo.com, 2004, Perl License
#______________________________________________________________________
use Math::Zap::Cube unit=>u;
use Test::Simple tests=>5;
ok(u eq 'cube(vector(0, 0, 0), vector(1, 0, 0), vector(0, 1, 0), vector(0, 0, 1))');
ok(u->a eq 'vector(0, 0, 0)');
ok(u->x eq 'vector(1, 0, 0)');
ok(u->y eq 'vector(0, 1, 0)');
ok(u->z eq 'vector(0, 0, 1)');Description
Define and manipulate a cube in 3 dimensions
package Math::Zap::Cube;
$VERSION=1.07;
use Math::Zap::Unique;
use Math::Zap::Triangle;
use Math::Zap::Vector check=>vectorCheck;
use Carp;Constructors
new
Create a rectangle from 3 vectors:
sub new($$$$)
{my ($a, $x, $y, $z) = vectorCheck(@_);
bless {a=>$a, x=>$x, y=>$y, z=>$z};
}cube
Synonym for "new"
sub cube($$$$) {new($_[0], $_[1], $_[2], $_[3])};unit
Unit cube
sub unit()
{cube(vector(0,0,0), vector(1,0,0), vector(0,1,0), vector(0,0,1));
}Methods
Check
Check that an anonymous reference is a reference to a cube and confess if it is not.
sub check(@)
{for my $c(@_)
{confess "$c is not a cube" unless ref($c) eq __PACKAGE__;
}
return (@_)
}is
Same as "check" but return the result to the caller.
sub is(@)
{for my $r(@_)
{return 0 unless ref($r) eq __PACKAGE__;
}
'cube';
}a, x, y, z
Components of cube
sub a($) {my ($c) = check(@_); $c->{a}}
sub x($) {my ($c) = check(@_); $c->{x}}
sub y($) {my ($c) = check(@_); $c->{y}}
sub z($) {my ($c) = check(@_); $c->{z}}Clone
Create a cube from another cube
sub clone($)
{my ($c) = check(@_); # Cube
bless {a=>$c->a, x=>$c->x, y=>$c->y, z=>$c->z};
}Accuracy
Get/Set accuracy for comparisons
my $accuracy = 1e-10;
sub accuracy
{return $accuracy unless scalar(@_);
$accuracy = shift();
}Add
Add a vector to a cube
sub add($$)
{my ($c) = check(@_[0..0]); # Cube
my ($v) = vectorCheck(@_[1..1]); # Vector
new($c->a+$v, $c->x, $c->y, $c->z);
}Subtract
Subtract a vector from a cube
sub subtract($$)
{my ($c) = check(@_[0..0]); # Cube
my ($v) = vectorCheck(@_[1..1]); # Vector
new($c->a-$v, $c->x, $c->y, $c->z);
}Multiply
Cube times a scalar
sub multiply($$)
{my ($a) = check(@_[0..0]); # Cube
my ($b) = @_[1..1]; # Scalar
new($a->a, $a->x*$b, $a->y*$b, $a->z*$b);
}Divide
Cube divided by a non zero scalar
sub divide($$)
{my ($a) = check(@_[0..0]); # Cube
my ($b) = @_[1..1]; # Scalar
confess "$b is zero" if $b == 0;
new($a->a, $a->x/$b, $a->y/$b, $a->z/$b);
}Print cube
sub print($)
{my ($t) = check(@_); # Cube
my ($a, $x, $y, $z) = ($t->a, $t->x, $t->y, $t->z);
"cube($a, $x, $y, $z)";
}Triangulate
Triangulate cube
sub triangulate($$)
{my ($c) = check(@_[0..0]); # Cube
my ($color) = @_[1..1]; # Color
my $plane; # Plane
my @t;
$plane = unique();
push @t, {triangle=>triangle($c->a, $c->a+$c->x, $c->a+$c->y), color=>$color, plane=>$plane};
push @t, {triangle=>triangle($c->a+$c->x+$c->y, $c->a+$c->x, $c->a+$c->y), color=>$color, plane=>$plane};
$plane = unique();
push @t, {triangle=>triangle($c->a+$c->z, $c->a+$c->x+$c->z, $c->a+$c->y+$c->z), color=>$color, plane=>$plane};
push @t, {triangle=>triangle($c->a+$c->x+$c->y+$c->z, $c->a+$c->x+$c->z, $c->a+$c->y+$c->z), color=>$color, plane=>$plane};
# x y z
# y z x
$plane = unique();
push @t, {triangle=>triangle($c->a, $c->a+$c->y, $c->a+$c->z), color=>$color, plane=>$plane};
push @t, {triangle=>triangle($c->a+$c->y+$c->z, $c->a+$c->y, $c->a+$c->z), color=>$color, plane=>$plane};
$plane = unique();
push @t, {triangle=>triangle($c->a+$c->x, $c->a+$c->y+$c->x, $c->a+$c->z+$c->x), color=>$color, plane=>$plane};
push @t, {triangle=>triangle($c->a+$c->y+$c->z+$c->x, $c->a+$c->y+$c->x, $c->a+$c->z+$c->x), color=>$color, plane=>$plane};
# x y z
# z x y
$plane = unique();
push @t, {triangle=>triangle($c->a, $c->a+$c->z, $c->a+$c->x), color=>$color, plane=>$plane};
push @t, {triangle=>triangle($c->a+$c->z+$c->x, $c->a+$c->z, $c->a+$c->x), color=>$color, plane=>$plane};
$plane = unique();
push @t, {triangle=>triangle($c->a+$c->y, $c->a+$c->z+$c->y, $c->a+$c->x+$c->y), color=>$color, plane=>$plane};
push @t, {triangle=>triangle($c->a+$c->z+$c->x+$c->y, $c->a+$c->z+$c->y, $c->a+$c->x+$c->y), color=>$color, plane=>$plane};
@t;
}
unless (caller())
{$c = cube(vector(0,0,0), vector(1,0,0), vector(0,1,0), vector(0,0,1));
@t = $c->triangulate('red');
print "Done";
}Operator Overloads
Operator overloads
use overload
'+', => \&add3, # Add a vector
'-', => \&sub3, # Subtract a vector
'*', => \&multiply3, # Multiply by scalar
'/', => \÷3, # Divide by scalar
'==' => \&equals3, # Equals
'""' => \&print3, # Print
'fallback' => FALSE;Add
Add operator.
sub add3
{my ($a, $b, $c) = @_;
return $a->add($b);
}Subtract
Subtract operator.
sub sub3
{my ($a, $b, $c) = @_;
return $a->subtract($b);
}Multiply
Multiply operator.
sub multiply3
{my ($a, $b) = @_;
return $a->multiply($b);
}Divide
Divide operator.
sub divide3
{my ($a, $b, $c) = @_;
return $a->divide($b);
}Equals
Equals operator.
sub equals3
{my ($a, $b, $c) = @_;
return $a->equals($b);
}Print a cube
sub print3
{my ($a) = @_;
return $a->print;
}Exports
use Math::Zap::Exports qw(
cube ($$$)
unit ()
);
#______________________________________________________________________
# Package loaded successfully
#______________________________________________________________________
1;Credits
Author
philiprbrenan@yahoo.com
Copyright
philiprbrenan@yahoo.com, 2004
License
Perl License.