{- | Deals with moving creature wall collisions.  -}
module Dodge.WallCreatureCollisions where
import Dodge.Data
import Dodge.Creature.State.Data
import Dodge.Debug.Flag.Data
import Dodge.Base
import Geometry

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

colCrsWalls :: World -> World
colCrsWalls w = over creatures (fmap (colCrWall w)) w

colCrWall :: World -> Creature -> Creature
colCrWall w c 
    | noclipIsOn && _crID c == 0 = c -- for noclip
    | p1 == p2  = pushOrCrush ls c
    | otherwise = c & crPos %~
        collideCorners rad wallPoints
        . collideWalls rad p1 ls 
        . checkPushThroughs p1 ls 
  where 
    rad = _crRad c + wallBuffer
    p1  = _crOldPos c
    p2  = _crPos c
    ls  = IM.elems $ _wlLine <$> wallsNearPoint p2 w
    wallPoints = nub $ concatMap (\(x,y) -> [x,y]) ls
    noclipIsOn = _noClip $ _debugFlags w

-- colCrPushThrough :: World -> Creature -> Creature
-- colCrPushThrough w cr = set crPos (checkPushThroughs rad p1 p2 ls) cr
--     where rad = _crRad cr + wallBuffer
--           p1  = _crOldPos cr
--           p2  = _crPos cr
--           ls  = IM.elems $ fmap _wlLine $ wallsNearPoint p2 w
-- -- probably best to push check pushing through walls before creature springs

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

-- 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
collideWalls :: Float -> Point2 -> [(Point2,Point2)] -> Point2 -> Point2
collideWalls rad cp1 wls cp2 = case (listToMaybe.mapMaybe (pushOutFromWall rad cp2)) wls of
    Nothing -> cp2
    Just cp3 -> case (listToMaybe.reverse.mapMaybe (pushOutFromWall rad cp3)) wls of
        Nothing -> cp3
        Just cp4 -> 0.5 *.* (cp4 +.+ cp1)

-- pushes a point out from a list of walls
-- if multiple new points occur, chooses the one closest to the orignal point
pushOutFromWalls :: Float -> [(Point2,Point2)] -> Point2 -> Point2
pushOutFromWalls rad wls p = 
    fromMaybe p
    . listToMaybe
    . sortBy (compare `on` dist p)
    $ mapMaybe (pushOutFromWall rad p) 
    wls

pushOrCrush :: [(Point2,Point2)] -> Creature -> Creature
pushOrCrush wls cr = case mapMaybe (pushOutFromWall (_crRad cr) cpos) wls of
    []  -> cr
    [p] -> cr & crPos .~ p
    _   -> cr & crState . crDamage %~ ( Blunt 50 cpos cpos cpos : )
  where
    cpos = _crPos 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 -- +.+ (1 *.* norm))
    | otherwise = Nothing
  where 
    norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2)
    wp1' = (rad *.* norm) +.+ wp1
    wp2' = (rad *.* norm) +.+ wp2
    newP = errorClosestPointOnLine 5 wp1' wp2' cp2
    isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad

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

checkPushThroughs :: Point2 -> [(Point2,Point2)] -> Point2 -> Point2
checkPushThroughs cp1 wls cp2
    = fromMaybe cp2 $ (listToMaybe.mapMaybe (checkPushThrough cp1 cp2)) wls

checkPushThrough :: Point2 -> Point2 -> (Point2,Point2) -> Maybe Point2
checkPushThrough cp1 cp2 (wp1,wp2) 
    | isPushedThrough = intersectSegSeg' cp1 cp2 wp1 wp2
    | otherwise = Nothing
  where
    --norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2)
    --wp1' = (rad *.* norm) +.+ wp1
    --wp2' = (rad *.* norm) +.+ wp2
    --newP = errorClosestPointOnLine 5 wp1' wp2' cp2
    isPushedThrough = isRHS wp1 wp2 cp2 && isJust (intersectSegSeg' cp1 cp2 wp1 wp2)