{-# LANGUAGE TupleSections #-}
{- | Basic collision detection for a moving point -}
module Dodge.Base.Collide
    where
import Dodge.Data
import Dodge.Base.Zone
import Geometry
import FoldableHelp

--import Data.List
import Data.Maybe
import qualified Data.IntMap.Strict as IM
import Control.Lens
import qualified FoldlHelp as L

hasLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasLOS #-}
hasLOS p1 p2 w = not $ pointHitsWalls p1 p2 $ wallsAlongLine p1 p2 w

hitPointLines
    :: Point2
    -> Point2
    -> [(Point2,Point2)]
    -> Maybe (Point2,(Point2,Point2))
hitPointLines p1 p2
    = safeMinimumOn (dist p1 . fst)
    . mapMaybe
    (\(x,y) -> (, (x,y)) <$> intersectSegSeg p1 p2 x y)

-- | looks for first collision of a point with walls
-- if found, gives point and reflection velocity
reflectPointWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
reflectPointWalls p1 p2 ws 
    = safeMinimumOn (dist p1 . fst)
    $ IM.mapMaybe 
        (( \(x,y) -> 
            fmap ( (, reflectIn (x -.- y) (p2 -.- p1)) 
                 . (+.+ errorNormalizeV 39 (vNormal (x -.- y)))
                 ) 
                 (intersectSegSeg p1 p2 x y)
         ) 
        . _wlLine) ws
-- | Looks for first collision of a point with walls.
-- If found, gives point and reflection velocity, reflection damped in normal.
reflectPointWallsDamped 
    :: Float    -- ^ Damping factor, probably should be in (0,1)
    -> Point2 
    -> Point2 
    -> IM.IntMap Wall 
    -> Maybe (Point2,Point2)
reflectPointWallsDamped dfact p1 p2 ws 
    = safeMinimumOn (dist p1 . fst)
    $ IM.mapMaybe 
        (( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1)) 
                            . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))) 
                                (intersectSegSeg p1 p2 x y)) 
         . _wlLine
        ) ws
-- | Test if a point collides with walls
pointHitsWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
pointHitsWalls p1 p2 
    = any $ isJust . uncurry (intersectSegSeg p1 p2) . _wlLine
-- | Test if there something blocking a walk
collidePointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
collidePointWalkable p1 p2 ws 
    = any (isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
    $ IM.filter (fromMaybe True . (^? doorPathable)) ws

furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
furthestPointWalkable p1 p2 ws 
    = fromMaybe p2
    . safeMinimumOn (dist p1) 
    $ IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) ws

collideDirectionIndirect 
    :: Float    -- ^max distance to look
    -> Point2   -- ^start point
    -> Point2   -- ^point in direction
    -> IM.IntMap Wall 
    -> Float
{-# INLINE collideDirectionIndirect #-}
collideDirectionIndirect d p1 p2 wls
    = fromMaybe d
    $
    ( L.fold
    . L.prefilter (not . _wlIsSeeThrough)
    . L.premapMaybe (fmap (dist p1) . uncurry (intersectSegSeg p1 p3) . _wlLine)
    ) L.minimum 
    wls
  where
    p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1)

collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
{-# INLINE collidePointIndirect #-}
collidePointIndirect  p1 p2
    = L.fold
    . L.prefilter (not . _wlIsSeeThrough)
    . L.premapMaybe (uncurry (intersectSegSeg p1 p2) . _wlLine)
    $ L.minimumOn (dist p1)
--collidePointIndirect p1 p2
--    = safeMinimumOn (dist p1) 
--    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) 
--    . IM.filter (not . _wlIsSeeThrough)

{- | Checks to see whether someone can fire bullets effectively between two points. 
 - Not sure if this needs vision as well, need to make this uniform. -}
collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
collidePointFire p1 p2 ws 
    = safeMinimumOn (dist p1) 
    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine ) 
    $ IM.filter (\wl -> not (_wlIsSeeThrough wl && isJust (wl ^? blHP))) ws
{- | Checks to see whether someone can fire bullets effectively between two points. 
 - Not sure if this needs vision as well, need to make this uniform. -}
collidePointFireVision :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
collidePointFireVision p1 p2 ws 
    = any ( isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
    $ IM.filter notBlockWindow ws
  where 
    notBlockWindow wl = case wl ^? blHP of
        Just _  -> not $ _wlIsSeeThrough wl
        Nothing -> True

hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
hasLOSIndirect p1 p2 w = case collidePointIndirect p1 p2 $ wallsAlongLine p1 p2 w of 
    Just _ -> False
    Nothing -> True

isWalkable :: Point2 -> Point2 -> World -> Bool
isWalkable p1 p2 w = not 
    $ collidePointWalkable p1 p2 
    $ wallsAlongLine p1 p2 w

canSee :: Int -> Int -> World -> Bool
canSee i j w = hasLOS p1 p2 w
  where 
    p1 = _crPos (_creatures w IM.! i)
    p2 = _crPos (_creatures w IM.! j)

canSeePoint :: Int -> Point2 -> World -> Bool
canSeePoint i p w = hasLOS p1 p w
  where
    p1 = _crPos (_creatures w IM.! i)

pathToPointFireable :: Int -> Point2 -> World -> Bool
pathToPointFireable i p w 
    = not 
    . pointHitsWalls (_crPos $ _creatures w IM.! i) p
    $ IM.filter (isNothing . (^? blHP) ) $ wallsAlongLine p1 p w
  where 
    p1 = _crPos (_creatures w IM.! i)

canSeePointAll :: Int -> Point2 -> World -> Bool
canSeePointAll i targPos w 
    = all (flip (canSeePoint i) w . (\p -> targPos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
  where 
    cr = _creatures w IM.! i
    radius = _crRad cr

canSeeAny :: Int -> Int -> World -> Bool
canSeeAny fromID toID w 
    = any (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
  where 
    cr = _creatures w IM.! toID
    cpos = _crPos cr
    radius = _crRad cr

canSeeAll :: Int -> Int -> World -> Bool
canSeeAll fromID toID w 
    = all (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
  where 
    cr = _creatures w IM.! toID
    cpos = _crPos cr
    radius = _crRad cr

canWalk :: Int -> Int -> World -> Bool
canWalk i j w = not $ collidePointWalkable ipos jpos $ wallsAlongLine ipos jpos w
  where 
    ipos = _crPos (_creatures w IM.! i)
    jpos = _crPos (_creatures w IM.! j)

canSeeIndirect :: Int -> Int -> World -> Bool
canSeeIndirect i j w = isNothing . collidePointIndirect ipos jpos $ wallsAlongLine ipos jpos w
  where 
    ipos = _crPos (_creatures w IM.! i)
    jpos = _crPos (_creatures w IM.! j)
    
canSeeFire :: Point2 -> Point2 -> World -> Bool
canSeeFire p p' w = not $ collidePointFireVision p p' $ wallsAlongLine p p' w

canSeeFireVision :: Int -> Int -> World -> Bool
canSeeFireVision i j w = canSeeFire ipos jpos w
  where 
    ipos = _crPos (_creatures w IM.! i)
    jpos = _crPos (_creatures w IM.! j)
{- | Test whether both of the outside lines between two creatures are blocked -}
canSeeFireVisionAny :: Int -> Int -> World -> Bool
canSeeFireVisionAny i j w 
    = not 
    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
    && collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
  where
    icr = _creatures w IM.! i
    jcr = _creatures w IM.! j
    ipos = _crPos icr
    jpos = _crPos jcr
    n = normalizeV $ vNormal $ ipos -.- jpos
    ni = _crRad icr *.* n
    nj = _crRad jcr *.* n
{- | Test whether either of the outside lines between two creatures are blocked -}
canSeeFireVisionAll :: Int -> Int -> World -> Bool
canSeeFireVisionAll i j w 
    = not 
    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
    || collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
  where
    icr = _creatures w IM.! i
    jcr = _creatures w IM.! j
    ipos = _crPos icr
    jpos = _crPos jcr
    n = normalizeV $ vNormal $ ipos -.- jpos
    ni = _crRad icr *.* n
    nj = _crRad jcr *.* n