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

import Control.Lens
import Data.Foldable
import qualified Data.IntSet as IS
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 wls
    pushthrough = crPos . _xy %~ fst . flip (collidePoint p1) wls -- check push throughs
    r = crRad (c ^. crType) + wallBuffer
    p1 = c ^. crOldPos . _xy
    p2 = c ^. crPos . _xy
    ls = _wlLine <$> wls
    ls' = filter (uncurry $ isLHS p1) ls
    wls = filter notff $ wlsNearCirc p2 r w
    notff x = x ^. wlMaterial /= ForceField

pushCr :: [Wall] -> Creature -> Creature
pushCr wls cr
    | dist ep sp > r && dist ep ap > r =
        ecr
            & crDamage <>~ [Crushing 1000 0]
            & crPos . _xy .~ ap
    | otherwise = ecr
  where
    ep = ecr ^. crPos . _xy
    ap = cr ^. crOldPos . _xy
    sp = cr ^. crPos . _xy
    ecr = foldl' f (cr & crWallTouch .~ mempty) wls
    r = crRad (cr ^. crType)
    f acr wl = case pushOutFromWall r (acr ^. crPos . _xy) (wl ^. wlLine) of
        Just p -> acr & crPos . _xy .~ p & crWallTouch %~ IS.insert (wl ^. wlID)
        Nothing -> acr

-- the amount to push creatures out from walls, extra to their radius
wallBuffer :: Float
wallBuffer = 0

-- 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

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))