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

import Control.Lens
import Data.Maybe
import Data.Monoid
import Dodge.Base
import Dodge.Data.Universe
import Dodge.Zoning.Wall
import Geometry

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

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

-- no noclip check, so no need for a configuration file
colCrWall :: World -> Creature -> Creature
colCrWall w c
    | p1 == p2 = pushOrCrush ls c
    --    | _crPos c' == _crPos c'' = c'
    --    | otherwise = c & crPos .~ _crOldPos c
    | otherwise = c'
  where
    --    c'' = c' & crPos %~ pushOutFromWalls rad ls
    --c'  = c & crPos %~ pushOutFromWalls' rad (reverse ls)
    c' =
        c & crPos
            %~ pushOutFromCorners r ls'
                . pushOutFromWalls r ls'
                . fst
                . flip (collidePoint p1) wls -- check push throughs
                --        . flip (collidePointWalls' p1) wls  -- check push throughs
    r = _crRad c + wallBuffer
    p1 = _crOldPos c
    p2 = _crPos c
    ls = _wlLine <$> wls
    ls' = filter (uncurry $ isLHS p1) ls
    wls = filter (not . _wlWalkable) $ wlsNearRect (p2 +.+ V2 r r) (p2 -.- V2 r r) w

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

pushCreatureOutFromWalls :: [(Point2, Point2)] -> Creature -> Creature
pushCreatureOutFromWalls ls cr = cr & crPos %~ pushOutFromWalls (_crRad cr) ls

-- the following tests whether or not a point is on a wall, and if so pushes it
-- out from the wall
-- this is then repeated if the point ends up on a new wall
pushOutFromWalls :: Float -> [(Point2, Point2)] -> Point2 -> Point2
pushOutFromWalls rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall rad p1)) wls of
    Nothing -> p1
    Just p2 -> pushOutFromWalls rad (tail wls) p2

-- possible improvement: choose between the closer of p2 and "p3" to p1

--pushOutFromWalls' :: Float -> [(Point2,Point2)] -> Point2 -> Point2
--pushOutFromWalls' rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall' rad p1)) wls of
--    Nothing -> p1
--    Just p2 -> fromMaybe p2 $ (getLast . foldMap (Last . pushOutFromWall' rad p2)) wls
--    -- possible improvement: choose between the closer of p2 and "p3" to p1

pushOrCrush :: [(Point2, Point2)] -> Creature -> Creature
pushOrCrush wls cr = case mapMaybe (pushOutFromWall (_crRad cr) cpos) wls of
    [] -> cr
    (p : _) -> cr & crPos .~ p
  where
    --    (_:p:_)   -> cr
    --        & crPos .~ p
    --        & crState . crDamage %~ ( Blunt 50 cpos cpos cpos : )

    cpos = _crPos cr

-- note the inclusion of endpoints in circOnSeg
crOnWall :: Creature -> World -> Bool
crOnWall cr =
    any (uncurry (circOnSeg p r) . _wlLine)
        . filter (not . _wlWalkable)
        . wlsNearPoint p
  where
    p = _crPos cr
    r = _crRad cr

-- 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
    norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2)
    wp1' = wp1 +.+ rad *.* norm
    wp2' = wp2 +.+ rad *.* norm
    newP = errorClosestPointOnLine 5 wp1' wp2' cp2
    isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad

pushOutFromCorners :: Float -> [(Point2, Point2)] -> Point2 -> Point2
--pushOutFromCorners r ls p = foldr (squashIntersectCirclePoint r . fst) p ls
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))