{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TemplateHaskell #-}

module Geometry.ConvexPoly (
    ConvexPoly (..),
    cpPoints,
    cpCen,
    cpRad,
    --    , centroid
    pointsToPoly,
    convexPolysOverlap,
    convexPolysOverlapWitness,
) where

import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Geometry.Data
import Geometry.Intersect
import Geometry.Polygon
import Geometry.Vector
import Control.Applicative

--import qualified Control.Foldl as L
data ConvexPoly = ConvexPoly
    { _cpPoints :: [Point2]
    , _cpCen :: Point2
    , _cpRad :: Float
    }
    deriving (Eq, Ord, Show, Read)--, Generic) --Generic, Flat)

--instance ToJSON ConvexPoly where
--    toEncoding = genericToEncoding defaultOptions
--
--instance FromJSON ConvexPoly

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)

-- | Test whether two polygons intersect or if one is contained in the other,
-- with witness.
convexPolysOverlapWitness :: ConvexPoly -> ConvexPoly -> Maybe (ConvexPoly, ConvexPoly,String)
convexPolysOverlapWitness cp1 cp2 
    | Just s <- polyPointsOverlapWitness (_cpPoints cp1) (_cpPoints cp2) = Just (cp1,cp2,s)
    | otherwise = Nothing


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

-- | Test whether two polygons intersect or if one is contained in the other.
polyPointsOverlapWitness :: [Point2] -> [Point2] -> Maybe String
polyPointsOverlapWitness (p : ps) (q : qs)
    | pointInPoly p (q : qs) = Just $ "Contained: "<> show p <> " in " <> show (q:qs)
    | pointInPoly q (p : ps) = Just $ "Contained: "<> show p <> " in " <> show (q:qs)
    | otherwise = polyPointsIntersectWitness (p : ps) (q : qs)
polyPointsOverlapWitness _ _ = Nothing

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

polyPointsIntersectWitness :: [Point2] -> [Point2] -> Maybe String
polyPointsIntersectWitness (a : b : xs) ps = go a (a : b : xs) ps
  where
    go x' (a' : b' : xs') ps' = pairPolyPointsIntersectWitness a' b' ps' <|> go x' (b' : xs') ps'
    go b' [a'] ps' = pairPolyPointsIntersectWitness a' b' ps'
    go _ _ _ = Nothing
polyPointsIntersectWitness _ _ = Nothing

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

pairPolyPointsIntersectWitness :: Point2 -> Point2 -> [Point2] -> Maybe String
pairPolyPointsIntersectWitness 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 = Just $ show a <> " " <> show b <> " " <> show c <> " " <> show d
        | otherwise = go x a b (d : xs)
    go d a b [c] 
        | intersectSegSegTest a b c d = Just $ show a <> " " <> show b <> " " <> show c <> " " <> show d
        | otherwise = Nothing
    go _ _ _ _ = Nothing
pairPolyPointsIntersectWitness _ _ _ = Nothing

makeLenses ''ConvexPoly
deriveJSON defaultOptions ''ConvexPoly