The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

 / 
Math-Zap-1.07
River stage zero No dependents
/ rectangle

Rectangle

Rectangles in 3d space

PhilipRBrenan@yahoo.com, 2004, Perl License

Synopsis

Example t/rectangle.t


            

              
              
#_ Rectangle __________________________________________________________
# Test 3d rectangles          
# philiprbrenan@yahoo.com, 2004, Perl License    
#______________________________________________________________________
use Math::Zap::Rectangle;
use Math::Zap::Vector;
use Test::Simple tests=>3;
my ($a, $b, $c, $d) =
 (vector(0,    0, +1),
  vector(0, -1.9, -1),
  vector(0, -2.0, -1),
  vector(0, -2.1, -1)
 );
my $r = rectangle
 (vector(-1,-1, 0),
  vector( 2, 0, 0),
  vector( 0, 2, 0)
 );
ok($r->intersects($a, $b) == 1);
ok($r->intersects($a, $c) == 1);
ok($r->intersects($a, $d) == 0);

Description

Rectangles in 3d space


            

              
              
package Math::Zap::Rectangle;
$VERSION=1.07;
use Math::Zap::Vector check=>'vectorCheck';
use Math::Zap::Matrix new3v=>'matrixNew3v';
use Carp;

Constructors

new

Create a rectangle from 3 vectors:


            

              
              
a position of any corner
b first side
c second side.

Note that vectors b,c must be at right angles to each other.


            

              
              
sub new($$$)
 {my ($a, $b, $c) = vectorCheck(@_);
  $b->dot($c) == 0 or confess 'non rectangular rectangle specified';
  bless {a=>$a, b=>$b, c=>$c}; 
 }

rectangle

Create a rectangle from 3 vectors - synonym for "new".


            

              
              
sub rectangle($$$) {new($_[0],$_[1],$_[2])};

Methods

check

Check its a rectangle


            

              
              
sub check(@)
 {for my $r(@_)
   {confess "$r is not a rectangle" unless ref($r) eq __PACKAGE__;
   }
  return (@_)
 }

is

Test its a rectangle


            

              
              
sub is(@)
 {for my $r(@_)
   {return 0 unless ref($r) eq __PACKAGE__;
   }
  'rectangle';
 }

a,b,c

Components of rectangle


            

              
              
sub a($) {my ($r) = check(@_); $r->{a}}
sub b($) {my ($r) = check(@_); $r->{b}}
sub c($) {my ($r) = check(@_); $r->{c}}

clone

Create a rectangle from another rectangle


            

              
              
sub clone($)
 {my ($r) = check(@_); # Rectangles
  bless {a=>$r->a, b=>$r->b, c=>$r->c};
 }

accuracy

Get/Set accuracy for comparisons


            

              
              
my $accuracy = 1e-10;
sub accuracy
 {return $accuracy unless scalar(@_);
  $accuracy = shift();
 }

intersection

Intersect line between two vectors with plane defined by a rectangle


            

              
              
r rectangle
a start vector
b end vector

Solve the simultaneous equations of the plane defined by the rectangle and the line between the vectors:


            

              
              
  ra+l*rb+m*rc         = a+(b-a)*n 
=>ra+l*rb+m*rc+n*(a-b) = a-ra

Note: no checks (yet) for line parallel to plane.


            

              
              
sub intersection($$$)
 {my ($r)     =       check(@_[0..0]); # Rectangles
  my ($a, $b) = vectorCheck(@_[1..2]); # Vectors
    
  $s = matrixNew3v($r->b, $r->c, $a-$b)/($a-$r->a);
 }

intersects

# Test whether a line between two vectors intersects a rectangle # Note: no checks (yet) for line parallel to plane.


            

              
              
sub intersects($$$)
 {my ($r)     =       check(@_[0..0]); # Rectangles
  my ($a, $b) = vectorCheck(@_[1..2]); # Vectors
    
  my $s = $r->intersection($a, $b);
  return 1 if $s->x >=0 and $s->x < 1 and
              $s->y >=0 and $s->y < 1 and
              $s->z >=0 and $s->z < 1;
  0;
 }

visible

# Visibility of a rectangle r hid by other rectangles R from a view # point p. # Rectangle r is divided up into I*J sub rectangles: each sub rectangle # is tested for visibility from point p via the intervening rectangles.


            

              
              
sub visible($$@)
 {my ($p)     = vectorCheck(@_[0.. 0]);    # Vector
  my ($I, $J) =            (@_[1.. 2]);    # Number of divisions  
  my ($r, @R) =       check(@_[3..scalar(@_)-1]);  # Rectangles
  my $v;
  $v->{r} = $r;                              # Save rectangle data
  $v->{I} = $I;                              # 
  $v->{J} = $J;                              #
  for      my $i(1..$I)                      # Along one edge
   {L: for my $j(1..$J)                      # Along the other edge
     {my $c = $r->a+($r->b)*(($i-1/2)/$I)    # Test point
                   +($r->c)*(($j-1/2)/$J);
       
      for my $R(@R)                          # Each intervening rectangle
       {my ($x, $y, $z) = ($c->x, $c->y, $c->z);
        my $in = $R->intersects($p, $c);
        next L if $in;                       # Solid, intersected
       }
      $v->{v}{$i}{$j} = 1;
     }
   }
  $v;
 }

project

# Project rectangle r onto rectangle R from a point p


            

              
              
sub project($$$)
 {my ($p)     = vectorCheck(@_[0.. 0]);    # Vector
  my ($r, $R) =            (@_[1.. 2]);    # Rectangles           
    
  my $A = $r->a;                             # Main  corner of r
  my $B = $r->a+$r->b;                       # One   corner of r
  my $C = $r->a+$r->c;                       # Other corner of r
  my $a = $R->intersection($p, $A);          # Main  corner of r on R
  my $b = $R->intersection($p, $B);          # One   corner of r on R
  my $c = $R->intersection($p, $C);          # Other corner of r on R
  $aR = $p+($A-$p)*$a->z;                    # Coordinates of main  corner of r on R
  $bR = $p+($B-$p)*$b->z;                    # Coordinates of one   corner of r on R
  $cR = $p+($C-$p)*$c->z;                    # Coordinates of other corner of r on R
  print "a=$aR\n";
  print "b=$bR\n";
  print "c=$cR\n";
  rectangle($aR, $bR, $cR);
 }

projectInto

# Project rectangle r into rectangle R from a point p


            

              
              
sub projectInto($$$)
 {my ($r, $R) =            (@_[0..1]);    # Rectangles           
  my ($p)     = vectorCheck(@_[2..2]);    # Vector
    
  my $A = $r->a;                             # Main     corner of r
  my $B = $r->a+$r->b;                       # One      corner of r
  my $C = $r->a+$r->c;                       # Other    corner of r
  my $D = $r->a+$r->b+$r->c;                 # Opposite corner of r
  my $a = $R->intersection($p, $A);          # Main     corner of r on R
  my $b = $R->intersection($p, $B);          # One      corner of r on R
  my $c = $R->intersection($p, $C);          # Other    corner of r on R
  my $d = $R->intersection($p, $D);          # Opposite corner of r on R
  ($a, $b, $d, $c);
 }

Exports

Export "rectangle"


            

              
              
use Math::Zap::Exports qw(
  rectangle ($$$)    
 );
#_ Rectangle __________________________________________________________
# Package loaded successfully
#______________________________________________________________________
1;

Credits

Author

philiprbrenan@yahoo.com

philiprbrenan@yahoo.com, 2004

License

Perl License.