Cubes in 3d space
PhilipRBrenan@yahoo.com, 2004, Perl License
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)');
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;
Create a rectangle from 3 vectors:
sub new($$$$) {my ($a, $x, $y, $z) = vectorCheck(@_); bless {a=>$a, x=>$x, y=>$y, z=>$z}; }
Synonym for "new"
sub cube($$$$) {new($_[0], $_[1], $_[2], $_[3])};
Unit cube
sub unit() {cube(vector(0,0,0), vector(1,0,0), vector(0,1,0), vector(0,0,1)); }
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 (@_) }
Same as "check" but return the result to the caller.
sub is(@) {for my $r(@_) {return 0 unless ref($r) eq __PACKAGE__; } 'cube'; }
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}}
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}; }
Get/Set accuracy for comparisons
my $accuracy = 1e-10; sub accuracy {return $accuracy unless scalar(@_); $accuracy = shift(); }
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 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); }
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); }
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 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
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 operator.
sub add3 {my ($a, $b, $c) = @_; return $a->add($b); }
Subtract operator.
sub sub3 {my ($a, $b, $c) = @_; return $a->subtract($b); }
Multiply operator.
sub multiply3 {my ($a, $b) = @_; return $a->multiply($b); }
Divide operator.
sub divide3 {my ($a, $b, $c) = @_; return $a->divide($b); }
Equals operator.
sub equals3 {my ($a, $b, $c) = @_; return $a->equals($b); }
Print a cube
sub print3 {my ($a) = @_; return $a->print; }
Export "cube", "unit"
use Math::Zap::Exports qw( cube ($$$) unit () ); #______________________________________________________________________ # Package loaded successfully #______________________________________________________________________ 1;
philiprbrenan@yahoo.com
philiprbrenan@yahoo.com, 2004
Perl License.
To install Math::Zap::Draw, copy and paste the appropriate command in to your terminal.
cpanm
cpanm Math::Zap::Draw
CPAN shell
perl -MCPAN -e shell install Math::Zap::Draw
For more information on module installation, please visit the detailed CPAN module installation guide.