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:

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

philiprbrenan@yahoo.com, 2004

License

Perl License.