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

Line2

Lines in 2d space

PhilipRBrenan@yahoo.com, 2004, Perl License

Synopsis

Example t/line2.t

#_ Vector _____________________________________________________________
# Test 2d lines    
# philiprbrenan@yahoo.com, 2004, Perl License    
#______________________________________________________________________

use Math::Zap::Line2;
use Math::Zap::Vector2;
use Test::Simple tests=>12;

my $x = vector2(1,0);
my $y = vector2(0,1);
my $c = vector2(0,0);

my $a = line2( -$x,  +$x);
my $b = line2( -$y,  +$y);
my $B = line2(3*$y, 4*$y);

ok($a->intersect($b) == $c);
ok($b->intersect($a) == $c);
ok($a->intersectWithin($b) == 1);
ok($a->intersectWithin($B) == 0);
ok($b->intersectWithin($a) == 1);
ok($B->intersectWithin($a) == 1);
ok($a->parallel($b) == 0);
ok($B->parallel($b) == 1);
ok(!$b->intersectWithin($B), 'Parallel intersection');
ok( line2(-$x,       $x)->crossOver(line2(-$y,       $y)), 'Crosses 1');
ok(!line2(-$x,       $x)->crossOver(line2( $y * 0.5, $y)), 'Crosses 2');
ok(!line2( $x * 0.5, $x)->crossOver(line2( $y * 0.5, $y)), 'Crosses 3');

Description

Manipulate lines in 2D space

package Math::Zap::Line2;
$VERSION=1.07;
use Math::Zap::Vector2 check=>'vector2Check';
use Math::Zap::Matrix2 new2v=>'matrix2New2v';
use Carp;
use constant debug => 0; # Debugging level

Constructors

new

Create a line from two vectors

sub new($$)
 {vector2Check(@_) if debug;
  my $l = bless {a=>$_[0], b=>$_[1]};
  short($l, 1);
  $l; 
 }

line2

Create a line from two vectors

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

Methods

accuracy

Get/Set accuracy for comparisons

my $accuracy = 1e-10;

sub accuracy
 {return $accuracy unless scalar(@_);
  $accuracy = shift();
 }

short

Short line?

sub short($$)
 {my $l = shift;  # Line       
  my $a = 1e-4;   # Accuracy
  my $A = shift;  # Action 0: return indicator, 1: confess 
  my $n =
     ($l->{a}{x}-$l->{b}{x})**2 + ($l->{a}{y}-$l->{b}{y})**2                                      
    < $a;
  confess "Short line2" if $n and $A;
  $n;      
 }

check

Check its a line

sub check(@)
 {unless (debug)
   {for my $l(@_)
     {confess "$l is not a line" unless ref($l) eq __PACKAGE__;
     }
   }
   @_;
 }

is

Test its a line

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

a,b,ab,ba

Components of line

sub a($)  {check(@_) if (debug); $_[0]->{a}}
sub b($)  {check(@_) if (debug); $_[0]->{b}}
sub ab($) {check(@_) if (debug); vector2($_[0]->{b}{x}-$_[0]->{a}{x}, $_[0]->{b}{y}-$_[0]->{a}{y})}
sub ba($) {check(@_) if (debug); $_[0]->a-$_[0]->b}

clone

Create a line from another line

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

print

Print line

sub print($)
 {my ($l) = check(@_); # Lines
  my ($a, $b) = ($l->a, $l->b);
  my ($A, $B) = ($a->print, $b->print);  
  "line2($A, $B)";
 }

angle

Angle between two lines

sub angle($$)
 {my ($a, $b) = check(@_); # Lines
  $a->a-$a->b < $b->a-$b->b;     
 }

parallel

Are two lines parallel

sub parallel($$)
 {my ($a, $b) = check(@_); # Lines

# return 1 if abs(1 - abs($a->ab->norm * $b->ab->norm)) < $accuracy;
  return 1 if abs(1 - abs($a->ab->norm * $b->ab->norm)) < 1e-3;     
  0;
 }

intersect

Intersection of two lines

sub intersect($$)
 {my ($a, $b) = check(@_); # Lines

  return 0 if $a->parallel($b);
  my $i = matrix2New2v($a->ab, $b->ba) / ($b->a - $a->a);

  $a->a+$i->x*$a->ab;
 }

intersectWithin

Intersection of two lines occurs within second line?

sub intersectWithin($$)
 {my ($a, $b) = check(@_); # Lines

  return 0 if $a->parallel($b);
  my $i = matrix2New2v($a->ab, $b->ba) / ($b->a - $a->a);

  0 <= $i->y and $i->y <= 1;
 }

crossOver

Do the two line segments cross over each other?

sub crossOver($$)
 {my ($a, $b) = check(@_); # Lines

  return 0 if $a->parallel($b);
  my $i = matrix2New2v($a->ab, $b->ba) / ($b->a - $a->a);

  0 <= $i->x and $i->x <= 1 and 0 <= $i->y and $i->y <= 1;
 }

Exports

Export "line2"

use Math::Zap::Exports qw(
  line2  ($$)
 );

#_ Line2 ______________________________________________________________
# Package loaded successfully
#______________________________________________________________________

1;

Credits

Author

philiprbrenan@yahoo.com

philiprbrenan@yahoo.com, 2004

License

Perl License.