The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.

Line2

Lines in 2d space

PhilipRBrenan@yahoo.com, 2004, Perl License

Synopsis

#example t/line2.t

Description

Manipulate lines in 2D space

 package line2;
 use vector2 check=>'vector2Check';
 use 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 exports qw(
   line2  ($$)
  );
 
 #_ Line2 ______________________________________________________________
 # Package loaded successfully
 #______________________________________________________________________
 
 1;