{-# LANGUAGE TupleSections #-}
{- | Basic collision detection for a moving point.
 - Conventions: input is typically a stream of walls.
 - Collide returns an endpoint and maybe a collided with
 - object (wall).
 - Reflect maybe gives a slightly pushed out point from a collision and a
 - relection velocity. 
 - Overlap returns a stream of walls.
 - A point will typically be moving.
 - A ball refers to a moving circle, i.e. a point with a radius.
 - -}
module Dodge.Base.Collide
    ( collidePoint
    , collideSegCrs
    , collidePointWallsFilterStream
    , collidePointTestFilter
    , overlapSegWalls
    , overlapSegCrs
    , overlap1SegCrs
    , bounceBall
    , bouncePoint
    , sortStreamOn
    , minStreamOn
    , collideCircWallsStream
    , circOnSomeWall
    , circOnAnyCr
    , overlapCircWalls
    , overlapCircWallsClosest
    , crsNearPoint
    , allVisibleWalls

    , hasLOS
    , hasLOSIndirect
    , hasButtonLOS
    , canSee
    , canSeeIndirect
    , isWalkable

    , anythingHitCirc
    ) where
import Dodge.Data
import Dodge.Zone
import Dodge.Zoning
import Dodge.Base.Wall
import Geometry

import Data.Maybe
import qualified IntMapHelp as IM
import Control.Lens
import Control.Monad
import StreamingHelp
import qualified Streaming.Prelude as S
import qualified Data.IntSet as IS

collidePoint :: Point2 -> Point2 
    -> StreamOf Wall
    -> (Point2, Maybe Wall)
{-# INLINE collidePoint #-}
collidePoint sp ep = runIdentity . S.fold_ findPoint (ep, Nothing) id
  where
    findPoint (p,mwl) wl = maybe (p,mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl

overlap1SegCrs :: Point2 -> Point2 
    -> [Creature]
    -> [(Point2, Creature)]
{-# INLINE overlap1SegCrs #-}
overlap1SegCrs sp ep = mapMaybe 
    (\cr -> (,cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep ))

overlapSegCrs :: Point2 -> Point2 
    -> StreamOf Creature
    -> StreamOf ([Point2], Creature)
{-# INLINE overlapSegCrs #-}
overlapSegCrs sp ep = S.mapMaybe 
    (\cr -> f cr $ intersectCircSeg (_crPos cr) (_crRad cr) sp ep )
  where
    f _  [] = Nothing
    f cr ps = Just (ps,cr)

collideSegCrs :: Point2 -> Point2 
    -> StreamOf Creature
    -> (Point2, Maybe Creature)
{-# INLINE collideSegCrs #-}
collideSegCrs sp ep = runIdentity . S.fold_ findPoint (ep, Nothing) id
  where
    findPoint (p,mcr) cr 
        = maybe (p,mcr) (,Just cr) $ listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp p)

doBounce :: Float -> Point2 -> Point2 -> (Point2, Maybe Wall) -> Maybe (Point2, Point2)
{-# INLINE doBounce #-}
doBounce x sp ep (p, mwl) = mwl <&> \wl ->
    ( p +.+ normalizeV (vNormal (uncurry (-.-) (_wlLine wl)))
    , reflVelWallDamp x wl (ep -.- sp)
    )

bounceBall :: Float -> Point2 -> Point2 -> Float 
    -> StreamOf Wall
    -> Maybe (Point2,Point2)
{-# INLINE bounceBall #-}
bounceBall x sp ep r = doBounce x sp ep . collideCircWallsStream sp ep r

bouncePoint :: (Wall -> Bool) -> Float -> Point2 -> Point2 -> World -> Maybe (Point2,Point2)
{-# INLINE bouncePoint #-}
bouncePoint t x sp ep = doBounce x sp ep . collidePointWallsFilterStream t sp ep

-- this COULD be written in terms of collidePointWallsFilterStream, TODO test
-- whether this is actually faster
collidePointTestFilter :: (Wall -> Bool) -> Point2 -> Point2 -> StreamOf Wall -> Bool
{-# INLINE collidePointTestFilter #-}
collidePointTestFilter t sp ep = runIdentity 
    . S.any_ (isJust . uncurry (intersectSegSeg sp ep) . _wlLine)
    . S.filter t

collidePointWallsFilterStream :: (Wall -> Bool) -> Point2 -> Point2 -> World -> (Point2, Maybe Wall)
{-# INLINE collidePointWallsFilterStream #-}
collidePointWallsFilterStream t sp ep = collidePoint sp ep
    . S.filter t
    . wlsNearSeg sp ep

overlapSegWalls :: Point2 -> Point2 -> StreamOf Wall
    -> StreamOf (Point2,Wall)
{-# INLINE overlapSegWalls #-}
overlapSegWalls sp ep = S.mapMaybe $ \wl -> uncurry (intersectSegSeg sp ep) (_wlLine wl) <&> (,wl)

visibleWalls :: Point2 -> Point2 -> World -> StreamOf (Point2,Wall)
{-# INLINE visibleWalls #-}
visibleWalls sp ep = S.take 1 <=<  -- hlint, was using join and fmap
    ( S.span (not . wlIsOpaque . snd)
    . sortStreamOn (dist sp . fst)
    . overlapSegWalls sp ep
    . wlsNearSeg sp ep    )

allVisibleWalls :: World -> StreamOf (Point2,Wall)
{-# INLINE allVisibleWalls #-}
allVisibleWalls w = concats $ S.subst (flip (visibleWalls vPos) w . (+.+ vPos)) $ S.each (nRays 20)
  where
    vPos = _cameraViewFrom w
    
overlapCircWalls :: Point2 -> Float -> StreamOf Wall
    -> StreamOf (Point2,Wall)
{-# INLINE overlapCircWalls #-}
overlapCircWalls p r = S.mapMaybe dointersect
  where
    dointersect wl = f (_wlLine wl) <&> (,wl)
    f (a,b) = intersectSegSeg p (p +.+ r *.* normalizeV ((0.5 *.* (a +.+ b)) -.- p)) a b

-- | note that this does not push the circle away from the wall at all
collideCircWallsStream :: Point2 -> Point2 -> Float -> StreamOf Wall
    -> (Point2, Maybe Wall)
{-# INLINE collideCircWallsStream #-}
collideCircWallsStream sp ep rad = runIdentity . S.fold_ findPoint (ep, Nothing) id
  where
    findPoint (p,mwl) wl = maybe (p,mwl) (,Just wl) . uncurry (intersectSegSeg sp p) 
        . shiftbyrad
        . _wlLine $ wl
    shiftbyrad (a,b) = bimap f f
        (a +.+ rad *.* normalizeV (a -.-b)
        ,b +.+ rad *.* normalizeV (b -.-a)
        )
      where
        f = (+.+) (rad *.* normalizeV (vNormal $ a -.- b))

overlapCircWallsClosest :: Point2 -> Float -> StreamOf Wall -> Maybe (Point2,Wall)
{-# INLINE overlapCircWallsClosest #-}
overlapCircWallsClosest p r = minStreamOn (dist p . fst)
    . overlapCircWalls p r

{- | Test if a circle collides with any wall. 
 - Note no check on whether the wall is walkable. -}
circOnSomeWall :: Point2 -> Float -> World -> Bool
{-# INLINE circOnSomeWall #-}
circOnSomeWall p rad = runIdentity . S.any_ (uncurry (circOnSeg p rad) . _wlLine)
    . wlsNearPoint p

circOnAnyCr :: Point2 -> Float -> World -> Bool
{-# INLINE circOnAnyCr #-}
circOnAnyCr p r w = IS.foldr f False $ crIXsNearPoint p w
  where
    f cid bl = maybe False (\cr -> dist p (_crPos cr) < r + _crRad cr) (w ^? creatures . ix cid) || bl

{- | More general collision tests follow -}

hasLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasLOS #-}
hasLOS p1 p2 = not 
    . collidePointTestFilter (const True) p1 p2
    . wlsNearSeg p1 p2

hasButtonLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasButtonLOS #-}
hasButtonLOS p1 p2 = not
    . collidePointTestFilter (not . _wlTouchThrough) p1 p2
    . wlsNearSeg p1 p2

hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasLOSIndirect #-}
hasLOSIndirect p1 p2 = not
    . collidePointTestFilter wlIsOpaque p1 p2
    . wlsNearSeg p1 p2

isWalkable :: Point2 -> Point2 -> World -> Bool
{-# INLINE isWalkable #-}
isWalkable p1 p2 = not 
    . collidePointTestFilter (not . (^?! wlPathable)) p1 p2 
    . wlsNearSeg p1 p2

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

canSeeIndirect :: Int -> Int -> World -> Bool
{-# INLINE canSeeIndirect #-}
canSeeIndirect i j w = hasLOSIndirect ipos jpos w
  where 
    ipos = _crPos (_creatures w IM.! i)
    jpos = _crPos (_creatures w IM.! j)

anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
  where
    hitCr    = IS.foldr f False $ crsNearSeg sp ep w
    f cid bl = maybe False (\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
            (w ^? creatures . ix cid)
        || bl

    hitWl    = collideCircWallsStream sp ep rad $ wlsNearPoint ep w
                                                    -- this should probably be wallsOnLine or something