{- | Deals with moving creature wall collisions.  -}
module Dodge.WallCreatureCollisions 
    ( colCrsWalls
    , colCrWall
    , pushCreatureOutFromWalls
    , crOnWall
    ) where
import Dodge.Data
--import Dodge.Data.DamageType
--import Dodge.Creature.State.Data
import Dodge.Zone
import Dodge.Base
import Geometry

import Data.Monoid
import Data.Maybe
import Data.Function
import Control.Lens
import qualified Data.IntMap.Strict as IM

colCrsWalls :: World -> World
colCrsWalls w = w & creatures %~ fmap (colCrWall w)

colCrWall :: World -> Creature -> Creature
colCrWall w c 
    | noclipIsOn && _crID c == 0 = c -- for noclip
    | 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 rad ls
        . pushOutFromWalls rad ls 
        . flip (collidePointWalls p1) wls  -- check push throughs
    rad = _crRad c + wallBuffer
    p1  = _crOldPos c
    p2  = _crPos c
    ls  = IM.elems $ _wlLine <$> wls
    wls = IM.filter (not . _wlWalkable) $ wallsNearPoint p2 w
    --wallPoints = map fst ls
    noclipIsOn = _debug_noclip $ _config 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 -> fromMaybe p2 $ (getLast . foldMap (Last . pushOutFromWall rad p2)) wls
    -- 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
--    (_:p:_)   -> cr 
--        & crPos .~ p
--        & crState . crDamage %~ ( Blunt 50 cpos cpos cpos : )
  where
    cpos = _crPos cr

-- note the inclusion of endpoints in circOnSeg
crOnWall :: Creature -> World -> Bool
crOnWall cr w = any (\(a,b) -> circOnSeg a b p r) wls
  where
    p = _crPos cr
    r = _crRad cr
    wls = fmap _wlLine . IM.filter (not . _wlWalkable) $ wallsNearPoint p w
 
-- 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
--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
--    isOnWall = circOnSeg wp1 wp2 cp2 rad

pushOutFromCorners :: Float -> [(Point2,Point2)] -> Point2 -> Point2
pushOutFromCorners r ls p = foldr (intersectCirclePoint r . fst) p ls

--pushOutFromCorners' :: World -> Creature -> Creature
--pushOutFromCorners' w cr = cr & crPos .~ newPos
--  where
--    newPos = foldr (intersectCirclePoint (_crRad cr)) (_crPos cr) ls
--    ls  = nub . concatMap (\(x,y) -> [x,y]) . IM.elems $ _wlLine <$> wallsNearPoint (_crPos cr) w

--collideCorners :: Float -> [Point2] -> Point2 -> Point2
--collideCorners rad ps p2 = foldr (intersectCirclePoint rad) p2 ps

---- collide circles with points (outer corners)
intersectCirclePoint :: Float -> Point2 -> Point2 -> Point2
intersectCirclePoint rad p cCen 
    | dist cCen p > rad = cCen
    | otherwise         = p +.+ (rad *.* errorNormalizeV 65 (cCen -.- p))