module Dodge.WallCreatureCollisions where
-- imports {{{
import Dodge.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 
    | p1 == p2  = pushOrCrush ls c
    | otherwise = c & crPos %~
        collideCorners rad p1 wallPoints
        . collideWalls rad p1 ls 
        . checkPushThroughs rad p1 ls 
  where 
    rad = _crRad c + wallBuffer
    p1  = _crOldPos c
    p2  = _crPos c
    ls  = IM.elems $ fmap _wlLine $ wallsNearPoint p2 w
    wallPoints = nub $ concat ls

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

-- 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
collideWalls rad cp1 walls cp2
    = case (listToMaybe.mapMaybe (pushOutFromWall rad cp2)) walls of
            Nothing -> cp2
            Just cp3 -> case (listToMaybe.reverse.mapMaybe (pushOutFromWall rad cp3)) walls of
                                         Nothing -> cp3
                                         Just cp4 -> cp4

-- 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
pushOutFromWalls rad walls p = 
    fromMaybe p
    . listToMaybe
    . sortBy (compare `on` dist p)
    $ mapMaybe (pushOutFromWall rad p) 
    walls

pushOrCrush :: [[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] -> 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
          isJust Nothing = False
          isJust _       = True

pushOutFromCorners :: World -> Creature -> Creature
pushOutFromCorners w cr = cr & crPos .~ newPos
  where
    newPos = foldr (intersectCirclePoint (_crRad cr)) (_crPos cr) ls
    ls  = nub . concat . IM.elems $ fmap _wlLine $ wallsNearPoint (_crPos cr) w

collideCorners :: Float -> Point2 -> [Point2] -> Point2 -> Point2
collideCorners rad p1 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 :: Float -> Point2 -> [[Point2]] -> Point2 -> Point2
checkPushThroughs rad cp1 walls cp2
    = fromMaybe cp2 $ (listToMaybe.mapMaybe (checkPushThrough rad cp1 cp2)) walls

checkPushThrough :: Float -> Point2 -> Point2 -> [Point2] -> Maybe (Point2)
checkPushThrough  rad 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)
          isJust Nothing = False
          isJust _       = True