File Coverage

blib/lib/Math/Intersection/StraightLine.pm

Criterion	Covered	Total	%
statement	98	101	97.0
branch	31	36	86.1
condition	29	45	64.4
subroutine	12	12	100.0
pod	5	5	100.0
total	175	199	87.9

package Math::Intersection::StraightLine;

use 5.006001;
use strict;
use warnings;
our $VERSION = '0.04';

sub new{
  my ($class) = @_;
  my $self = {};
  bless $self,$class;
  return $self;
}# new

sub functions{
  my ($self,$f_one,$f_two) = @_;
  my $factor   = 3;
  my $line_one = [
                   [0,$f_one->[1]],
                   [$factor,($f_one->[0] * $factor) + $f_one->[1]],
                 ];
  my $line_two = [
                   [0,$f_two->[1]],
                   [$factor,($f_two->[0] * $factor) + $f_two->[1]],
                 ];
  return $self->points($line_one,$line_two);
}# function

sub vectors{
  my ($self,$vector_one,$vector_two) = @_;
  my @equation_one = ($vector_one->[0]->[0],$vector_one->[1]->[0],
                      $vector_two->[0]->[0],$vector_two->[1]->[0],);
  my @equation_two = ($vector_one->[0]->[1],$vector_one->[1]->[1],
                      $vector_two->[0]->[1],$vector_two->[1]->[1],);
  my $factor_one   = $vector_two->[1]->[1];
  my $factor_two   = $vector_two->[1]->[0];

  for(@equation_one){
    $_ *= $factor_one;
  }

  for(@equation_two){
    $_ *= $factor_two;
  }

  my @result_equation;
  for(0..3){
    push(@result_equation,$equation_one[$_] - $equation_two[$_]);
  }

  my $point = undef;

  if($result_equation[1] != 0){
    my $constant = $result_equation[2] - $result_equation[0];
    my $lambda   = $constant / $result_equation[1];

    $point       = [$vector_one->[0]->[0] + ($vector_one->[1]->[0] * $lambda),
                    $vector_one->[0]->[1] + ($vector_one->[1]->[1] * $lambda),];
  }
  if(_check_parallel_vectors($vector_one,$vector_two)){
    if(defined _check_point_on_vector($vector_one,$vector_two->[0])){
      $point = -1;
    }
    else{
      $point = 0;
    }
  }
  return $point;
}# vectors

sub point_limited{
  my ($self,$line_one,$line_two) = @_;
  my @coords_one = @$line_one;
  my @coords_two = @$line_two;
  my $vector_one = [$coords_one[0],[$coords_one[0]->[0] - $coords_one[1]->[0],
                                    $coords_one[0]->[1] - $coords_one[1]->[1]]];
  my $vector_two = [$coords_two[0],[$coords_two[0]->[0] - $coords_two[1]->[0],
                                    $coords_two[0]->[1] - $coords_two[1]->[1]]];
  my $result = $self->vectors($vector_one,$vector_two);
  my $return = 0;
  if(defined $result && ref($result) eq 'ARRAY' &&
     _check_point_on_line($vector_one,$result) &&
     _check_point_on_line($vector_two,$result)){
    $return = $result;
  }
  if(_check_overlapping_lines($line_one,$line_two,$vector_one,$vector_two)){
    $return = -1;
  }
  return $return;
}# point_limited


sub points{
  my ($self,$line_one,$line_two) = @_;
  my @coords_one = @$line_one;
  my @coords_two = @$line_two;
  my $vector_one = [$coords_one[0],[$coords_one[0]->[0] - $coords_one[1]->[0],
                                    $coords_one[0]->[1] - $coords_one[1]->[1]]];
  my $vector_two = [$coords_two[0],[$coords_two[0]->[0] - $coords_two[1]->[0],
                                    $coords_two[0]->[1] - $coords_two[1]->[1]]];
  my $result = $self->vectors($vector_one,$vector_two);
  my $return = 0;
  if(defined $result && ref($result) eq 'ARRAY'){
    $return = $result;
  }
  if(_check_overlapping_lines($line_one,$line_two,$vector_one,$vector_two)){
    $return = -1;
  }
  return $return;
}# points

sub _check_point_on_line{
  my ($vector,$point) = @_;
  my $return    = 1;

  my $check = _check_point_on_vector($vector,$point);
  if(!defined $check || $check > 0 || $check < -1){
    $return = 0;
  }

  return $return;
}# _check_point_on_line

sub _check_overlapping_lines{
  my ($line_one,$line_two,$vector_one,$vector_two) = @_;
  my $return = 0;
  if(_check_point_on_line($vector_one,$line_two->[0]) ||
        _check_point_on_line($vector_one,$line_two->[1]) ||
        _check_point_on_line($vector_two,$line_one->[0]) ||
        _check_point_on_line($vector_two,$line_one->[1])){
    $return = 1;
  }
  return $return;
}# _check_overlapping_lines

sub _check_parallel_vectors{
  my ($vector_one,$vector_two) = @_;
  my $return = 0;
  for(0,1){
    if(($vector_one->[1]->[0] == 0 && $vector_two->[1]->[0] == 0) ||
       ($vector_one->[1]->[1] == 0 && $vector_two->[1]->[1] == 0)){
      $return = 1;
    }
    else{
      unless($vector_two->[1]->[0] == 0 || $vector_two->[1]->[1] == 0){
        my $quot_one = $vector_one->[1]->[0] / $vector_two->[1]->[0];
        my $quot_two = $vector_one->[1]->[1] / $vector_two->[1]->[1];
        if($quot_one == $quot_two){
          $return = 1;
        }
      }
    }
  }
  return $return;
}# _check_parallel_vectors

sub _check_point_on_vector{
  my ($vector,$point) = @_;
  my $return          = undef;
  my $tmp_check       = undef;
  for(0,1){
    if($vector->[1]->[$_] == 0 && ($point->[$_] != $vector->[0]->[$_])){
      $return = 0;
      last;
    }
    elsif($vector->[1]->[$_] != 0){
      my $check = ($point->[$_] - $vector->[0]->[$_]) / $vector->[1]->[$_];
      unless(defined $tmp_check){
        $tmp_check = $check;
      }
      elsif(abs($tmp_check - $check) > 0.00001){
        $return = 0;
      }
    }
  }
  if(defined $return && $return == 0){
    $return = undef;
  }
  elsif(! defined $return){
    $return = $tmp_check;
  }
  return $return;
}# _check_point_on_vector

1;
__END__