=pod

=encoding utf8

=head1 Name

 Math::Intersection::Circle::Line - Find the points at which circles and lines
 intersect.

=head1 Synopsis

 use Math::Intersection::Circle::Line q(:all);
 use Test::More q(no_plan);
 use utf8;

 # A line segment across a circle is never longer than the diameter

 if (1)                                                                         # Random circle and random line
  {my ($x, $y, $r, $𝘅, $𝘆, $𝕩, $𝕪) = map {rand()} 1..7;
   intersectionCircleLine                                                       # Find intersection of a circle and a line
    {return ok 1 unless @_ == 4;                                                # Ignore line unless it crosses circle
     ok &vectorLength(@_) <= 2*$r;                                              # Length if line segment is less than or equal to that of a diameter
 	 } $x, $y, $r, $𝘅, $𝘆, $𝕩, $𝕪;                                                # Circle and line to be intersected
  }

 # The length of a side of a hexagon is the radius of a circle inscribed through
 # its vertices

 if (1)
  {my ($x, $y, $r) = map {rand()} 1..3;                                         # Random circle
   my @p = intersectionCircles {@_} $x, $y, $r, $x+$r, $y, $r;                  # First step of one radius
 	 my @𝗽 = intersectionCircles {@_} $x, $y, $r, $p[0], $p[1], $r;               # Second step of one radius
 	 my @q = !&near($x+$r, $y, @𝗽[0,1]) ? @𝗽[0,1] : @𝗽[2,3];                      # away from start point
 	 my @𝗾 = intersectionCircles {@_} $x, $y, $r, $q[0], $q[1], $r;               # Third step of one radius
   ok &near2(@𝗾[0,1], $x-$r, $y) or                                             # Brings us to a point
      &near2(@𝗾[2,3], $x-$r, $y);                                               # opposite to the start point
  }

 # Circle through three points chosen at random has the same centre regardless of
 # the pairing of the points

 sub circleThrough3
  {my ($x, $y, $𝘅, $𝘆, $𝕩, $𝕪) = @_;                                            # Three points
 	&intersectionLines
 	 (sub                                                                         # Intersection of bisectors is the centre of the circle
 	   {my @r =(&vectorLength(@_, $x, $y),                                        # Radii from centre of circle to each point
 	            &vectorLength(@_, $𝘅, $𝘆),
 	            &vectorLength(@_, $𝕩, $𝕪));
 	    ok &near(@r[0,1]);                                                        # Check radii are equal
 	    ok &near(@r[1,2]);
       @_                                                                       # Return centre
 		 }, rotate90AroundMidPoint($x, $y, $𝘅, $𝘆),                                 # Bisectors between pairs of points
 		    rotate90AroundMidPoint($𝕩, $𝕪, $𝘅, $𝘆));
  }

 if (1)
  {my (@points) = map {rand()} 1..6;                                            # Three points chosen at random
   ok &near2(circleThrough3(@points), circleThrough3(@points[2..5, 0..1]));     # Circle has same centre regardless
   ok &near2(circleThrough3(@points), circleThrough3(@points[4..5, 0..3]));     # of the pairing of the points
  }

=cut

package Math::Intersection::Circle::Line;

#-------------------------------------------------------------------------------
# Locate the points at which lines and circles cross in two dimensions
# Philip R Brenan at gmail dot com, Appa Apps Ltd, 2015
#-------------------------------------------------------------------------------

use v5.18;
use warnings FATAL => qw(all);
use strict;
use utf8;
use Carp;

#-------------------------------------------------------------------------------
# Our definition of nearness
#-------------------------------------------------------------------------------

our $near = 1e-6;                                                               # Define nearness

sub near($;$) {return abs(($_[1]//0) - $_[0]) < $near}                          # Values this close are considered identical

sub near2($$;$$)                                                                # Check that we are near enough
 {my ($a, $b, $A, $B) = @_;
  near($A//0, $a) &&
  near($B//0, $b)
 }

sub near4($$$$;$$$$)                                                            # Check that we are near enough
 {my ($a, $b, $c, $d, $A, $B, $C, $D) = @_;
  near($A//0, $a) &&
  near($B//0, $b) &&
  near($C//0, $c) &&
  near($D//0, $d)
 }

#-------------------------------------------------------------------------------
# Length of a vector
#-------------------------------------------------------------------------------

sub vectorLength($$;$$)                                                         # Length of a vector
 {my ($x, $y, $𝘅, $𝘆) = @_;
  sqrt(($x-($𝘅//0))**2+($y-($𝘆//0))**2)
 }

#-------------------------------------------------------------------------------
# Average of two vectors
#-------------------------------------------------------------------------------

sub midPoint($$$$)
 {my ($x, $y, $𝘅, $𝘆) = @_;
  (($x+$𝘅) / 2, ($y+$𝘆) / 2)
 }

#-------------------------------------------------------------------------------
# Rotations
#-------------------------------------------------------------------------------

sub rotate90CW ($$) {my ($x, $y) = @_; (+$y, -$x)}                              # Clockwise
sub rotate90CCW($$) {my ($x, $y) = @_; (-$y, +$x)}                              # Counter clockwise

sub rotate90AroundMidPoint($$$$)
 {my ($x, $y, $𝘅, $𝘆) = @_;
	my ($𝕩, $𝕪) = map {$_/2} rotate90CW($𝘅 - $x, $𝘆 - $y);
	my ($X, $Y) = &midPoint(@_);
	($X - $𝕩, $Y - $𝕪, $X + $𝕩, $Y + $𝕪)
 }

#-------------------------------------------------------------------------------
# Intersection of a circle A, with a circle B.
#
# Known: coordinates of the centre and radius of each circle  x, y, r, 𝘅, 𝘆, 𝗿
#
# Two different circles either do not intersect, or if they do, they intersect
# at one or two points.  If they intersect at two points, the intersections are
# mirror images of each othe in the line that connects the centres of the two
# circles.
#
# Let 𝗟 be the line joining the two centres with length 𝗹 = a + 𝗮 where a is the
# distance from (x, y) along 𝗟 to the point closest to the intersections. Then:
#
#   r*r-a*a == 𝗿*𝗿-𝗮*𝗮
#   r*r-𝗿*𝗿  == a*a-𝗮*𝗮
#           == a*a-𝗮*𝗮 = (a+𝗮)(a-𝗮) == 𝗹*(a-𝗮) == 𝗹*(a - (𝗹 - a)) = 2*a*𝗹 - 𝗹*𝗹
#
#   a == (r*r-𝗿*𝗿 + 𝗹*𝗹)/ (2*𝗹)
#
# The distance 𝗮 at right angles to 𝗟 to an intersection is sqrt(r*r-a*a)
#
# The unit vector 𝕕 == (𝕩, 𝕪) along line 𝗟 from (x,y) to (𝘅, 𝘆) is the unit in
# direction: (𝘅-x, 𝘆-y)
#
# The unit vectors d, 𝗱 at right angles to 𝗟 are (-𝕪, 𝕩) and (𝕪, -𝕩)
#-------------------------------------------------------------------------------

sub intersectionCircles(&$$$$$$)
 {my ($sub,                                                                     # Sub routine to process intersection
      $x, $y, $r,                                                               # First circle centre, radius
      $𝘅, $𝘆, $𝗿) = @_;                                                         # Second circle centre, radius

  near($x, $𝘅) and near($y, $𝘆) and near($r, $𝗿) and                            # Complain if the two circles are in fact the same circle within the definition of nearness
    confess "Duplicate circles!  Please provide two distinct circles.";

  my ($𝕏, $𝕐) = ($𝘅 - $x, $𝘆 - $y);                                             # Vector between centres
  my $𝗹 = vectorLength($𝕏, $𝕐);                                                 # Distance between centres
  return &$sub() if $𝗹 > $r + $𝗿 or $𝗹 < abs($r - $𝗿);                          # The circles are too far apart or too close to intersect

  my ($𝕩, $𝕪) = ($𝕏 / $𝗹, $𝕐 / $𝗹);                                             # Unit vector between centres
  my $a = ($r*$r - $𝗿*$𝗿 + $𝗹*$𝗹)/ (2*$𝗹);                                      # Length of the common side

  return &$sub($x+$𝕩*$a, $y+$𝕪*$a) if near($𝗹,     $r + $𝗿) or                  # The circles touch at one point if within the definition of nearness
                                      near($𝗹, abs($r - $𝗿));

  my $𝗮 = sqrt($r*$r-$a*$a);
  &$sub($x+$𝕩*$a-$𝕪*$𝗮, $y+$𝕪*$a+$𝕩*$𝗮,                                         # The circles touch at two points
        $x+$𝕩*$a+$𝕪*$𝗮, $y+$𝕪*$a-$𝕩*$𝗮);
 }

#-------------------------------------------------------------------------------
# Position on a line closest to a specified point
#
# Known: two points on the line 𝗟 such that: 𝗹 = (𝘅, 𝘆), 𝕝 = (𝕩, 𝕪) and the
# specified point 𝗽 = (x, y).  We want to find 𝗰 the point on 𝗟 closest to 𝗽.
#
# A circle with centre 𝗹 through 𝗽 will intersect a circle with centre 𝕝 through
# 𝗽 at 𝗾. 𝗰 is then the average of 𝗽 and 𝗾.
#-------------------------------------------------------------------------------

sub intersectionLinePoint(&$$$$$$)
 {my ($sub,                                                                     # Sub routine to process intersection
      $𝘅, $𝘆, $𝕩, $𝕪,                                                           # Two points on line 𝗹
      $x, $y) = @_;                                                             # The point 𝗽

  near($𝘅, $𝕩) and near($𝘆, $𝕪) and confess "Points on line are too close!";

  my $𝗿 = vectorLength($𝘅 - $x, $𝘆 - $y);                                       # Radius of first circle
  my $𝕣 = vectorLength($𝕩 - $x, $𝕪 - $y);                                       # Radius of second circle
  intersectionCircles
   {return &$sub(@_) if @_ == 2;                                                # Point is on line
    my ($x, $y, $𝘅, $𝘆) = @_;
    &$sub(($x+$𝘅) / 2, ($y+$𝘆) / 2)
   } $𝘅, $𝘆, $𝗿, $𝕩, $𝕪, $𝕣;
 }

#-------------------------------------------------------------------------------
# Intersection of two lines
#
# Given two lines l specified by two points 𝗹 = (𝘅, 𝘆),  𝕝 = (𝕩, 𝕪) and
#                 L specified by two points 𝗟 = (𝗫, 𝗬), 𝕃 = (𝕏, 𝕐)
# We want to find 𝗰 the point where the two lines intersect (if they do)
#
# Let the closest point to 𝗟 on l be 𝗮 and the closest point to 𝗮 on 𝗟 by 𝗯.
# L𝗮𝗯 is similar to L𝗮𝗰.
#-------------------------------------------------------------------------------

sub intersectionLines(&$$$$$$$$)
 {my ($sub,                                                                     # Sub routine to process intersection
      $𝘅, $𝘆, $𝕩, $𝕪,                                                           # Two points on line l
      $𝗫, $𝗬, $𝕏, $𝕐) = @_;                                                     # Two points on line L

  near($𝘅, $𝕩) and near($𝘆, $𝕪) and confess "Points on first line are too close!";
  near($𝗫, $𝕏) and near($𝘆, $𝕪) and confess "Points on second line are too close!";

  intersectionLinePoint                                                         # Find 𝗮
   {my ($𝗮x, $𝗮y) = @_;

    if (near($𝗮x, $𝗫) and near($𝗮y, $𝗬))                                        # The two lines might be collinear
     {intersectionLinePoint
       {my ($𝕒x, $𝕒y) = @_;
        near($𝕒x, $𝕏) and near($𝕒y, $𝕐) and
          confess "Collinear lines!  Please provide two distinct lines.";
       } $𝘅, $𝘆, $𝕩, $𝕪, $𝕏, $𝕐;
     }

    intersectionLinePoint                                                       # Find 𝗯
     {my ($𝗯x, $𝗯y) = @_;
      my $Lb = vectorLength($𝗫 - $𝗯x, $𝗬 - $𝗯y);                                # Distance from 𝗟 to 𝗯
      return &$sub() if near($Lb);                                              # Parallel lines
      my $La = vectorLength($𝗫 - $𝗮x, $𝗬 - $𝗮y);                                # Distance from 𝗟 to 𝗮
      my $s  = ($La / $Lb) ** 2;                                                # Scale factor for 𝗟𝗯
      &$sub($𝗫 + $s * ($𝗯x - $𝗫), $𝗬 + $s * ($𝗯y - $𝗬))                         # Point of intersection
     } $𝗫, $𝗬,  $𝕏, $𝕐,  $𝗮x, $𝗮y;                                              # Find 𝗯 on second line
   } $𝘅, $𝘆,  $𝕩, $𝕪,   $𝗫, $𝗬;                                                 # Find 𝗮 on first line
 }
#-------------------------------------------------------------------------------
# Intersection of a circle with a line
#
# Given a circle specified by its centre: (x, y), and radius: r
# and a line that passes through points: ($𝘅, $𝘆) and ($𝕩, $𝕪)
# find the two points at which the line crosses the circle or the single point
# at which the line touches the circle or report that there are no points in
# common.
#
# If the line crosses the circle we can draw an isoceles triangle from the
# centre of the circle to the points of intersection, with the line forming the
# base of said triangle.  The centre of the base is the closest point on the
# line to the centre of the circle. The line is at right angles to the line
# from the centre of the circle to the centre of the base.
#-------------------------------------------------------------------------------

sub intersectionCircleLine(&$$$$$$$)
 {my ($sub,                                                                     # Sub routine to process intersection
      $x, $y, $r,                                                               # Circle centre, radius
      $𝘅, $𝘆, $𝕩, $𝕪) = @_;                                                     # Line goes through these two points

  near($𝘅, $𝕩) and near($𝘆, $𝕪) and confess "Points on line are too close!";
  near($r) and confess "Radius is too small!";

  intersectionLinePoint
   {my ($X, $Y) = @_;                                                           # Midpoint on line
    if (near($x, $X) and near($y, $Y))                                          # Line passes through centre of circle
     {my ($𝗫, $𝗬) = ($𝕩 - $𝘅, $𝕪 - $𝘆);                                         # Vector along line
      my $D = vectorLength($𝗫, $𝗬);                                             # Length of vector along line
      my $s = $r/$D;                                                            # Length from midpoint along line to circumference relative to length from centre to midpoint
      return &$sub($x + $s * $𝗫, $y + $s * $𝗬, $x - $s * $𝗫, $y - $s * $𝗬);     # Intersection points
     }
    my ($𝗫, $𝗬) = ($X - $x, $Y - $y);                                           # Centre to midpoint
    my $𝗗 = vectorLength($𝗫, $𝗬);                                               # Distance to midpoint
    return &$sub()       if      $𝗗 > $r;                                       # Midpoint outside circle
    return &$sub($X, $Y) if near($𝗗,  $r);                                      # Tangent
    my $𝔻 = sqrt($r*$r - $𝗗*$𝗗);                                                # Length from midpoint along line to circumference
    my $s = $𝔻/$𝗗;                                                              # Length from midpoint along line to circumference relative to length from centre to midpoint
    &$sub($X - $s * $𝗬, $Y + $s * $𝗫, $X + $s * $𝗬, $Y - $s * $𝗫)               # Intersection points
   } $𝘅, $𝘆,  $𝕩, $𝕪,  $x, $y;                                                  # Find point on line closest to centre of circle
 }

#-------------------------------------------------------------------------------
# Intersection of a circle with a line - alternative method to confirm tests
#
# Known 𝘅, 𝘆, r, X, x, Y, y find l,t
#
# Circle(t)    Line(l) from (X,Y) to (x,y)
# 𝘅+𝗿*cos(t) = X+l*(X-x)
# 𝘆+𝗿*sin(t) = Y+l*(Y-y)
#
# 𝗿*cos(t)   = X+l*(X-x)-𝘅   let 𝗫 = X - x, 𝕏 = X - 𝘅 => 𝗿*cos(t) == 𝕏 + l𝗫
# 𝗿*sin(t)   = Y+l*(Y-y)-𝘆   let 𝗬 = Y - y, 𝕐 = Y - 𝘆 => 𝗿*sin(t) == 𝕐 + l𝗬
#
# rr         = 𝕏𝕏 + ll𝗫𝗫 + l2𝕏𝗫  + 𝕐𝕐 + ll𝗬𝗬 + l2𝕐𝗬
# 0          = ll(a = 𝗫𝗫 + 𝗬𝗬) + l(b = 2(𝕏𝗫  + 𝕐𝗬)) + (c = 𝕏𝕏 + 𝕐𝕐 - rr)
#
# Quadratic equation axx+bx+c has roots:
#
# x1, x2  = -b/2a +- sqrt(bb-4ac)/2a
#-------------------------------------------------------------------------------

# sub intersectionCircleLine2(&$$$$$$$)
#  {my ($sub,                                                                   # Sub routine to process intersection
#       $𝘅, $𝘆, $𝗿,                                                             # Circle centre, radius
#       $X, $Y, $x, $y) = @_;                                                   # Line goes through these two points
#   near($𝘅, $X) and near($𝘆, $Y) and confess "Points on line are too close!";
#   near($𝗿) and confess "Radius is too small!";
#
#   my $𝗫 = $X - $x; my $𝕏 = $X - $𝘅;
#   my $𝗬 = $Y - $y; my $𝕐 = $Y - $𝘆;
#
#   my $a =      $𝗫*$𝗫 + $𝗬*$𝗬;                                                 # Quadratic coefficients
#   my $b = 2 * ($𝕏*$𝗫 + $𝕐*$𝗬);
#   my $c =     ($𝕏*$𝕏 + $𝕐*$𝕐 - $𝗿*$𝗿);
#
#   my $𝗱 = $b * $b - 4 * $a * $c;                                              # Determinant
#
#   return &$sub() if $𝗱 < 0;                                                   # No point of contact
#
#   my $𝗰 = -$b / (2 * $a);                                                     # Centre of solution
#
#   if (near($𝗱))                                                               # Tangent within definition of nearness
#    {my $l = $𝗰;
#     return &$sub($X + $l * $𝗫, $Y + $l * $𝗬);
#    }
#                                                                               # Two crossing points
#   my $d = sqrt($𝗱) / (2 * $a);
#   my ($l, $𝗹) = ($𝗰 + $d, $𝗰 - $d);
#   &$sub($X + $l * $𝗫, $Y + $l * $𝗬, $X + $𝗹 * $𝗫, $Y + $𝗹 * $𝗬)
#  }
#

# Export details

require 5;
require Exporter;

use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);

@ISA       = qw(Exporter);
@EXPORT    = qw(intersectionCircles intersectionCircleLine intersectionLines intersectionLinePoint);
@EXPORT_OK = qw(midPoint near near2 near4 rotate90CW rotate90CCW rotate90AroundMidPoint vectorLength);
$EXPORT_TAGS{all} = [@EXPORT, @EXPORT_OK];
$VERSION   = '1.002'; # Thursday 20 Aug 2015

=head1 Description

 Find the points at which circles and lines intersect.

 Fast and easy to use these functions are written in 100% Pure Perl.

=head2 intersectionCircles 𝘀𝘂𝗯 circle1, circle2

 Find the points at which two circles intersect.  Complains if the two circles
 are identical.

 𝘀𝘂𝗯 specifies a subroutine to be called with the coordinates of the
 intersection points if there are any or an empty parameter list if there are
 no points of intersection.

 A circle is specified by supplying a list of three numbers:

  (𝘅, 𝘆, 𝗿)

 where (𝘅, 𝘆) are the coordinates of the centre of the circle and (𝗿) is its
 radius.

 Returns what ever is returned by 𝘀𝘂𝗯.

=head2 intersectionCircleLine 𝘀𝘂𝗯 circle, line

 Find the points at which a circle and a line intersect.

  𝘀𝘂𝗯 specifies a subroutine to be called with the coordinates of the
 intersection points if there are any or an empty parameter list if there are
 no points of intersection.

 A circle is specified by supplying a list of three numbers:

  (𝘅, 𝘆, 𝗿)

 where (𝘅, 𝘆) are the coordinates of the centre of the circle and (𝗿) is its
 radius.

 A line is specified by supplying a list of four numbers:

  (x, y, 𝘅, 𝘆)

 where (x, y) and (𝘅, 𝘆) are the coordinates of two points on the line.

 Returns what ever is returned by 𝘀𝘂𝗯.

=head2 intersectionLines 𝘀𝘂𝗯 line1, line2

 Finds the point at which two lines intersect.

  𝘀𝘂𝗯 specifies a subroutine to be called with the coordinates of the
 intersection point or an empty parameter list if the two lines do not
 intersect.

 Complains if the two lines are collinear.

 A line is specified by supplying a list of four numbers:

  (x, y, 𝘅, 𝘆)

 where (x, y) and (𝘅, 𝘆) are the coordinates of two points on the line.

 Returns what ever is returned by 𝘀𝘂𝗯.

=head2 intersectionLinePoint 𝘀𝘂𝗯 line, point

 Find the point on a line closest to a specified point.

  𝘀𝘂𝗯 specifies a subroutine to be called with the coordinates of the
 intersection points if there are any.

 A line is specified by supplying a list of four numbers:

  (x, y, 𝘅, 𝘆)

 where (x, y) and (𝘅, 𝘆) are the coordinates of two points on the line.

 A point is specified by supplying a list of two numbers:

  (𝘅, 𝘆)

 where (𝘅, 𝘆) are the coordinates of the point.

 Returns what ever is returned by 𝘀𝘂𝗯.

=head2 $Math::Intersection::Circle::Line::near

 As a finite computer cannot represent an infinite plane of points it is
 necessary to make the plane discrete by merging points closer than the
 distance contained in this variable, which is set by default to 1e-6.

=head1 Export

 The following functions are exported by default:

=over

=item C<intersectionCircles()>

=item C<intersectionCircleLine()>

=item C<intersectionLines()>

=item C<intersectionLinePoint()>

=back

 Optionally some useful helper functions can also be exported either by
 specifying the tag :all or by naming the required functions individually:

=over

=item C<midPoint()>

=item C<near()>

=item C<near2()>

=item C<near4()>

=item C<rotate90CW()>

=item C<rotate90CCW ()>

=item C<rotate90AroundMidPoint()>

=item C<vectorLength()>

=back

=head1 Installation

 Standard Module::Build process for building and installing modules:

   perl Build.PL
   ./Build
   ./Build test
   ./Build install

 Or, if you're on a platform (like DOS or Windows) that doesn't require
 the "./" notation, you can do this:

   perl Build.PL
   Build
   Build test
   Build install

=head1 Author

 Philip R Brenan at gmail dot com

 http://www.appaapps.com

=head1 Copyright

 Copyright (c) 2015 Philip R Brenan.

 This module is free software. It may be used, redistributed and/or
 modified under the same terms as Perl itself.

=cut
