The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

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.