{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
module Geometry.ConvexPoly
    ( ConvexPoly (..)
    , cpPoints
    , cpCen
    , cpRad
--    , centroid
    , pointsToPoly
    , convexPolysOverlap
    , pointInPolyPoints
    ) where
import Geometry.Data
import Geometry.Vector
import Geometry.LHS
import Geometry.Intersect
import Geometry.Polygon

import Control.Lens
--import qualified Control.Foldl as L
data ConvexPoly = ConvexPoly
    { _cpPoints :: [Point2]
    , _cpCen    :: Point2
    , _cpRad    :: Float
    }
pointsToPoly :: [Point2] -> ConvexPoly
pointsToPoly xs = ConvexPoly
    { _cpPoints = xs
    , _cpCen    = cen
    , _cpRad    = maximum $ map (dist cen) xs
    }
  where
    cen = centroid xs
-- | Test whether two polygons intersect or if one is contained in the other.
convexPolysOverlap :: ConvexPoly -> ConvexPoly -> Bool
convexPolysOverlap cp1 cp2 = dist (_cpCen cp1) (_cpCen cp2) < _cpRad cp1 + _cpRad cp2
    && polyPointsOverlap (_cpPoints cp1) (_cpPoints cp2)

--pointInConvexPoly :: Point2 -> ConvexPoly -> Bool
--pointInConvexPoly p cp = dist p (_cpCen cp) < _cpRad cp
--    && pointInPolyPoints p (_cpPoints cp)

-- | Test whether two polygons intersect or if one is contained in the other.
polyPointsOverlap :: [Point2] -> [Point2] -> Bool
polyPointsOverlap (p:ps) (q:qs) = pointInPolyPoints p (q:qs)
    || pointInPolyPoints q (p:ps)
    || polyPointsIntersect (p:ps) (q:qs) 
polyPointsOverlap _ _ = False

-- | Test whether a point is strictly inside a polygon.
-- Supposes the points in the polygon are listed in anticlockwise order.
pointInPolyPoints :: Point2 -> [Point2] -> Bool
pointInPolyPoints !p (x:xs) = all (\l -> uncurry isLHS l p) $ zip (x:xs) (xs ++ [x])
pointInPolyPoints _ [] = False

polyPointsIntersect :: [Point2] -> [Point2] -> Bool
polyPointsIntersect (a:b:xs) ps = go a (a:b:xs) ps
  where
    go x' (a':b':xs') ps' = pairPolyPointsIntersect a' b' ps' || go x' (b':xs') ps'
    go b' [a'] ps' = pairPolyPointsIntersect a' b' ps'
    go _ _ _ = False
polyPointsIntersect _ _ = False

pairPolyPointsIntersect :: Point2 -> Point2 -> [Point2] -> Bool
pairPolyPointsIntersect a' b' (c':d':xs') = go c' a' b' (c':d':xs')
  where
    go x a b (c:d:xs) = intersectSegSegTest a b c d || go x a b (d:xs)
    go d a b [c] = intersectSegSegTest a b c d
    go _ _ _ _ = False
pairPolyPointsIntersect _ _ _ = False


makeLenses ''ConvexPoly