use Test::More tests => 3*(2*6 + 1);

use strict;
use warnings;

local $" = ',';

# Slope 1
{
	my $matcher = path_matcher({
		p1 => [0,0],
		p2 => [100,100],
	});
	# Points on edge of tolerance
	for ([0,20], [20,0], [40,60], [60,40], [80,100], [100,80]) {
		ok($matcher->(@$_), "slope 1: match [@$_]");
	}
	# Out of bounds
	for ([0,21], [21,0], [40,61], [61,40], [80,101], [101,80], [-1,20]) {
		ok(!$matcher->(@$_), "slope 1: not match [@$_]");
	}
}

# Slope 0
{
	my $matcher = path_matcher({
		p1 => [0,50],
		p2 => [100,50],
	});
	# Boundary cases
	for ([0,60], [0,40], [50,60], [50,40], [100,60], [100,40]) {
		ok($matcher->(@$_), "slope 0: match [@$_]");
	}
	# Out of bounds
	for ([0,61], [0,39], [50,61], [50,39], [100,61], [100,39], [-1,60]) {
		ok(!$matcher->(@$_), "slope 0: not match [@$_]");
	}
}

# Slope INF
{
	my $matcher = path_matcher({
		p1 => [50,0],
		p2 => [50,100],
	});
	# Boundary cases
	for ([40,0], [60,0], [40,50], [60,50], [40,100], [60,100]) {
		ok($matcher->(@$_), "slope INF: match [@$_]");
	}
	# Out of bounds
	for ([39,0], [61,0], [39,50], [61,50], [39,100], [61,100], [40,-1]) {
		ok(!$matcher->(@$_), "slope INF: not match [@$_]");
	}
}

###
### Begin Actual functionality

sub path_matcher {
	my ($args_ref) = @_;
	my $p1 = delete $args_ref->{p1} || [delete @$args_ref{qw(x1 y1)}];
	my $p2 = delete $args_ref->{p2} || [delete @$args_ref{qw(x2 y2)}];
	my $sigma = delete $args_ref->{sigma} // '10%';
	
	die "Unknown parameters" if keys %$args_ref;
	die "Points must be defined" if grep {! defined} (@$p1, @$p2);
	
	# Order by x and y
	($p1, $p2) = sort {$a->[0] <=> $b->[0] || $a->[1] <=> $b->[1]} ($p1, $p2);

	my ($x1, $y1) = @$p1;
	my ($x2, $y2) = @$p2;

	# Solve y = m x + b
	my $dX = $x2 - $x1;
	my $dY = $y2 - $y1;
	my $m = $dX == 0 ? undef : $dY / $dX;
	my $b = $dX == 0 ? undef : $y1 - $m * $x1;
	
	# Sigma as a percentage of segment length
	if ($sigma =~ s/%//) {
		my $length = sqrt($dX ** 2 + $dY ** 2);
		$sigma *= $length / 100;
	}
	
	# Perpendicular M
	# M = -1 / m;
	# Y = M x + B
	my $M = ! defined $m ? 0 : $m == 0 ? undef : -1 / $m;
	
	# Anonymous sub to match multiple points.
	return sub {
		my ($x, $y) = @_;
		
		# Calculate [X,Y]: closest point on segment to [x,y]
		my ($X, $Y);
		
		# Vertical Line (constant x)
		if (! defined $m) {
			$X = $x1;
			$Y = $y;
			$Y = $y1 if $Y < $y1;
			$Y = $y2 if $Y > $y2;
		# Horizontal Line (constant y)
		} elsif ($m == 0) {
			$X = $x;
			$X = $x1 if $X < $x1;
			$X = $x2 if $X > $x2;
			$Y = $y1;
		# Regular line
		} else {
			my $B = $y - $M * $x;
			$X = ($B - $b) / ($m - $M);
			$Y = $m * $X + $b;
			($X,$Y) = ($x1, $y1) if $X < $x1;
			($X,$Y) = ($x2, $y2) if $X > $x2;
		}
		
		my $dist = sqrt(($x-$X) ** 2 + ($y-$Y) ** 2);
		
		return $dist <= $sigma;
	};
}