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 vectorSolve 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
Copyright
philiprbrenan@yahoo.com, 2004
License
Perl License.