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 = pushOutFromWall w c

pushOutFromWall :: World -> Creature -> Creature
pushOutFromWall w c 
    | p1 == p2 = c
    | otherwise = over crPos ( 
                              collideCorners rad p1 wallPoints
                             . 
                               collideWalls rad p1 ls 
                             . checkPushThroughs rad p1 ls 
                             ) 
                       c 
    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 a moving circle crosses a list of walls, and
-- places the circle accordingly.
-- It supposes that the circle will only interact with at most two walls.
-- the reverse prevents the collision from happening again with the first wall,
-- when two walls are collided with
collideWalls :: Float -> Point2 -> [[Point2]] -> Point2 -> Point2
collideWalls rad cp1 walls cp2
    = case (listToMaybe.mapMaybe (collideWall rad cp1 cp2)) walls of
            Nothing -> cp2
            Just cp3 -> case (listToMaybe.reverse.mapMaybe (collideWall rad cp1 cp3)) walls of
                                         Nothing -> cp3
                                         Just cp4 -> cp4

-- assumes that the wall is orientated
-- assumes wall points are different
collideWall :: Float -> Point2 -> Point2 -> [Point2] -> Maybe (Point2)
collideWall rad cp1 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 = circOnLine' wp1 wp2 cp2 rad
          isJust Nothing = False
          isJust _       = True

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