{-# LANGUAGE TupleSections #-}
{- | Basic collision detection for a moving point -}
module Dodge.Base.Collide
    ( hasLOS
    , hasButtonLOS
    , reflectPointWalls
    , ssfold
    , collidePointUpToIndirectMinDist
    , canSeeIndirect
    , isWalkable
    , canSee
    , hasLOSIndirect
    ) where
import Dodge.Data
import Dodge.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 = not . pointHitsWalls p1 p2 . wallsAlongLine p1 p2

hasButtonLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasButtonLOS #-}
hasButtonLOS p1 p2 = not . pointHitsWalls p1 p2
    . IM.filter (not . _wlTouchThrough) 
    . wallsAlongLine p1 p2

--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 . (^? wlPathable)) 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 wlIsOpaque
--    . L.premapMaybe (fmap (dist p1) . uncurry (intersectSegSeg p1 p3) . _wlLine)
--    ) L.minimum 
--    wls
--  where
--    p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1)

wlIsOpaque :: Wall -> Bool
wlIsOpaque wl = _wlOpacity wl == Opaque

--collidePointUpToIndirect
--    :: Point2   -- ^start point
--    -> Point2   -- ^end point
--    -> IM.IntMap Wall 
--    -> Point2
--{-# INLINE collidePointUpToIndirect #-}
--collidePointUpToIndirect p1 p2 = foldr f p2 . IM.filter wlIsOpaque
--  where
--    f wl x = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl

collidePointUpToIndirectMinDist
    :: Point2   -- ^start point
    -> Point2   -- ^end point
    -> Float    -- ^minimal possible distance
    -> IM.IntMap Wall 
    -> Point2
{-# INLINE collidePointUpToIndirectMinDist #-}
collidePointUpToIndirectMinDist p1 p2 md = ssfold prop f p2 . IM.filter wlIsOpaque
  where
    f x wl = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl
    prop p3 = dist p1 p3 < md

-- from haskell-cafe
-- short circuit a fold when a given property is satisfied
-- the fold builds a function that is then called on a0
ssfold :: Foldable t => (a -> Bool) -> (a -> b -> a) -> a -> t b -> a
{-# INLINABLE ssfold #-}
ssfold p f a0 xs = foldr (\x g a -> if p a then a else g (f a x)) id xs a0

collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
{-# INLINE collidePointIndirect #-}
collidePointIndirect p1 p2 = test . foldr f p2 . IM.filter wlIsOpaque
  where
    f wl p = fromMaybe p $ uncurry (intersectSegSeg p1 p) $ _wlLine wl
    test p | p == p2 = Nothing
           | otherwise = Just p

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

--{- | 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 (_wlFireThrough wl) || wlIsOpaque wl) 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 theTest ws
--  where 
--    theTest wl = not (_wlFireThrough wl) || wlIsOpaque wl

-- the reason for using the dashed version is the hope that this will short
-- circuit
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 (not . _wlFireThrough ) $ 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