-- | Deals with moving creature wall collisions.
module Dodge.WallCreatureCollisions (colCrsWalls) where

--import Control.Applicative
--import Data.Monoid
import Dodge.Door.DoorLerp
import Dodge.ShiftPoint
import Data.Maybe
import qualified Data.IntMap.Strict as IM
import Control.Lens
import Data.Foldable
import Dodge.Base
import Dodge.Creature.Radius
import Dodge.Data.Universe
import Dodge.Zoning.Wall
import Geometry
import Linear

colCrsWalls :: Universe -> Universe
colCrsWalls uv = uv & uvWorld . cWorld . lWorld . creatures %~ fmap (noclipCheck (_uvConfig uv) (_uvWorld uv))

noclipCheck :: Config -> World -> Creature -> Creature
noclipCheck cfig w c
    | debugOn Noclip cfig && _crID c == 0 = c -- for noclip
    | otherwise = colCrWall w c

colCrWall :: World -> Creature -> Creature
colCrWall w c = cornpush . wallpush $ pushthrough c
  where
    cornpush = crPos . _xy %~ pushOutFromCorners r ls'
    wallpush = pushCr (w ^. cWorld . lWorld) wls
    pushthrough = crPos . _xy %~ fst . flip (collidePoint p1) wls -- check push throughs
    r   | SlimeCrit {} <- c ^. crType = min 10 . crRad $ c ^. crType
        | otherwise = crRad $ c ^. crType
    p1 = c ^. crOldPos . _xy
    p2 = c ^. crPos . _xy
    ls = _wlLine <$> IM.elems wls
    ls' = filter (uncurry $ isLHS p1) ls
    wls = IM.filter notff $ wlsNearCirc p2 (2*r) w
    notff x = x ^. wlMaterial /= ForceField

-- might want to check angled crushing
pushCr :: LWorld -> IM.IntMap Wall -> Creature -> Creature
pushCr w wls cr
--    | (dist ep sp > r && dist ep ap > r)
--        || wlsCrush' w (cr ^. crPos . _xy) twls =
    | wlsCrush' w (cr ^. crPos . _xy) twls =
        ecr
            & crDamage <>~ [Crushing 1000 0 UnassignedO]
            & crPos . _xy .~ ap
--    | Just s <- wlsCrush w (cr ^. crPos . _xy) twls =
--        ecr
--            & crDamage <>~ [Crushing 1000 0]
--            & crPos . _xy .~ ap
--            & crName .~ s
    | otherwise = ecr
  where
--    stwls = IM.filter (\wl -> uncurry circOnSegNoEndpoints (wl ^. wlLine) sp r) wls
    twls = IM.elems $ IM.intersection wls (ecr ^. crWallTouch) -- `IM.union` stwls
--    ep = ecr ^. crPos . _xy
    ap = cr ^. crOldPos . _xy
--    sp = cr ^. crPos . _xy
    ecr = foldl' f (cr & crWallTouch .~ mempty) wls
    r   | SlimeCrit {} <- cr ^. crType = min 10 . crRad $ cr ^. crType
        | otherwise = crRad $ cr ^. crType
    f acr wl = case pushOutFromWall' r (acr ^. crPos . _xy) (wl ^. wlLine) of
        Just (p,hitp) -> acr & crPos . _xy .~ p & crWallTouch . at (wl ^. wlID) ?~ hitp
        Nothing -> acr

wallMovement :: LWorld -> Point2 -> Wall -> Point2
wallMovement w p wl = fromMaybe 0 $ do
    drid <- w ^? walls . ix (wl ^. wlID) . wlStructure . wsDoor 
    dr <- w ^? doors . ix drid
    let oldp = shiftPointBy (doDoorLerp dr (dr ^. drOldLerp)) 
            $ invShiftPointBy (doDoorLerp dr (dr ^. drLerp)) p
    return $ p - oldp

--wlsCrush :: LWorld -> Point2 -> [Wall] -> Maybe String
--wlsCrush _ _ [] = Nothing
--wlsCrush w p (x:xs) = getFirst (foldMap (First . wlWlCrush w p x) xs) <|> wlsCrush w p xs

wlsCrush' :: LWorld -> Point2 -> [Wall] -> Bool
wlsCrush' _ _ [] = False
wlsCrush' w p (x:xs) = any (wlWlCrush' w p x) xs || wlsCrush' w p xs

--wlWlCrush :: LWorld -> Point2 -> Wall -> Wall -> Maybe String
--wlWlCrush w p w1 w2 
--    | wlWlCrush' w p w1 w2 = Just $ show (w1 ^. wlID) <> ":" <> show (w2 ^. wlID)
--    | otherwise = Nothing

wlWlCrush' :: LWorld -> Point2 -> Wall -> Wall -> Bool
wlWlCrush' w p w1 w2 = (t w1 w2 || t w2 w1) -- test either wall is moving towards the other
        && norm (f w1 + f w2) < 0.2 -- test walls are facing each other
  where
--    t wl = dotV (vNormal (normalizeV (uncurry (-) (wl ^. wlLine)))) (wallMovement w p wl) > 0
    t x y = dotV (vNormal (normalizeV (uncurry (-) (x ^. wlLine))))
        (wallMovement w p x - wallMovement w p y) > 0
    f = normalizeV . uncurry (-) . (^. wlLine)

---- assumes that the wall is orientated
---- assumes wall points are different
--pushOutFromWall :: Float -> Point2 -> (Point2, Point2) -> Maybe Point2
--pushOutFromWall rad cp2 (wp1, wp2)
--    | isOnWall = Just newP
--    | otherwise = Nothing
--  where
--    n = errorNormalizeV 61 $ vNormal (wp1 - wp2)
--    wp1' = wp1 + rad *^ n
--    wp2' = wp2 + rad *^ n
--    newP = errorClosestPointOnLine 5 wp1' wp2' cp2
--    isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad

pushOutFromWall' :: Float -> Point2 -> (Point2, Point2) -> Maybe (Point2,Point2)
pushOutFromWall' rad cp2 (wp1, wp2)
    | isOnWall = Just (newP,newP - rad *^ n)
    | otherwise = Nothing
  where
    n = errorNormalizeV 61 $ vNormal (wp1 - wp2)
    wp1' = wp1 + rad *^ n
    wp2' = wp2 + rad *^ n
    newP = errorClosestPointOnLine 5 wp1' wp2' cp2
    isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad

pushOutFromCorners :: Float -> [(Point2, Point2)] -> Point2 -> Point2
pushOutFromCorners r = flip $ foldr (squashIntersectCirclePoint r . fst)

squashIntersectCirclePoint :: Float -> Point2 -> Point2 -> Point2
squashIntersectCirclePoint rad p cCen
    | dist cCen p > rad = cCen
    | otherwise = p + (rad *^ squashNormalizeV (cCen - p))