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.03;
 use Math::Zap::Unique;
 use Math::Zap::Triangle;
 use Math::Zap::Vector check=>vectorCheck;     
 use Carp;

Constructors

new

Create a rectangle from 3 vectors:

a position of corner
x first side
y second side
z third side
 
 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

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
  '/',       => \&divide3,   # 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

Print a cube

 
 sub print3
  {my ($a) = @_;
   return $a->print;
  }

Exports

Export cube, unit

 
 use Math::Zap::Exports qw(                               
   cube ($$$)  
   unit ()
  );
 
 #______________________________________________________________________
 # Package loaded successfully
 #______________________________________________________________________
 
 1;

Credits

Author

philiprbrenan@yahoo.com

Copyright

philiprbrenan@yahoo.com, 2004

License

Perl License.