module Gelatin.Core.Triangulation.Common where
import Linear
import Control.Lens
type Poly = [V2 Float]
signedArea :: Num a => [V2 a] -> a
signedArea = signedAreaOfPoints
signedAreaOfPoints :: Num a => [V2 a] -> a
signedAreaOfPoints lst =
sum [x1 * y2 - x2 * y1 | (V2 x1 y1, V2 x2 y2) <- zip lst $ rotateLeft lst]
rotateLeft :: [a] -> [a]
rotateLeft [] = []
rotateLeft (x:xs) = xs ++ [x]
insidePoly :: Poly -> Poly -> Bool
insidePoly poly1 poly2 | null poly1 = False
| null poly2 = False
| otherwise = and $ map (`pointInside` poly2) poly1
pointInside :: (V2 Float) -> Poly -> Bool
pointInside = flip pathHasPoint
pathHasPoint :: (R1 f, R2 f, Ord a, Fractional a) => [f a] -> f a -> Bool
pathHasPoint [] _ = False
pathHasPoint poly@(p1':_) p' = pointInPath' False p' (poly ++ [p1'])
where pointInPath' :: (R1 f, R2 f, Ord a, Fractional a) => Bool -> f a -> [f a] -> Bool
pointInPath' c _ [] = c
pointInPath' c _ [_] = c
pointInPath' c p (p1:p2:ps) = pointInPath' (test p p1 p2 $ c) p (p2:ps)
test :: (R2 f, Ord a, Fractional a) => f a -> f a -> f a -> (Bool -> Bool)
test p p1 p2 = if t1 p p1 p2 && t2 p p1 p2 then not else id
t1 :: (R2 f, Ord a) => f a -> f a -> f a -> Bool
t1 p p1 p2 = (y p2 > y p) /= (y p1 > y p)
t2 :: (R1 f, R2 f, Ord a, Fractional a) => f a -> f a -> f a -> Bool
t2 p p1 p2 = x p < (x p1 - x p2) * (y p - y p2) / (y p1 - y p2) + x p2
x v = v ^. _x
y v = v ^. _y
cycleNeighbours :: [a] -> [[a]]
cycleNeighbours xs | null xs = []
| otherwise = cycleN (head xs) xs
cycleN :: a -> [a] -> [[a]]
cycleN f xs | length xs >= 2 = cons ([head xs, head (tail xs)]) (cycleN f (tail xs))
| otherwise = [[head xs, f]]
triangleArea :: Fractional a => V2 a -> V2 a -> V2 a -> a
triangleArea (V2 x2 y2) (V2 x0 y0) (V2 x1 y1) = (x1-x0)*(y2-y0)-(x2-x0)*(y1-y0)