{-# 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,
    collidePointWallsFilter,
    collidePointTestFilter,
    collideCircWalls,
    overlapSegWalls,
    overlapSegCrs,
    bounceBall,
    bouncePoint,
    circOnSomeWall,
    circOnAnyCr,
    overlapCircWalls,
    overlapCircWallsClosest,
    crsNearPoint,
    allVisibleWalls,
    hasLOS,
    hasLOSIndirect,
    hasButtonLOS,
    canSee,
    canSeeIndirect,
    isWalkable,
    anythingHitCirc,
) where

import Control.Lens
import qualified Data.IntSet as IS
import Data.List (sortOn)
import Data.Maybe
import Dodge.Base.Wall
import Dodge.Data.World
import Dodge.Zoning
import FoldableHelp
import Geometry

collidePoint ::
    Point2 ->
    Point2 ->
    [Wall] ->
    (Point2, Maybe Wall)
{-# INLINE collidePoint #-}
collidePoint sp ep = foldl' findPoint (ep, Nothing)
  where
    findPoint (p, mwl) wl = maybe (p, mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl

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

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)))
        ( p +.+ normalizeV (vNormal (uncurry (-.-) (_wlLine wl)))
        , reflVelWallDamp x wl (ep -.- sp)
        )

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

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

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

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

collidePointWallsFilter :: (Wall -> Bool) -> Point2 -> Point2 -> World -> (Point2, Maybe Wall)
{-# INLINE collidePointWallsFilter #-}
collidePointWallsFilter t sp ep =
    collidePoint sp ep
        . 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)

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

visibleWalls :: Point2 -> Point2 -> World -> [(Point2, Wall)]
{-# INLINE visibleWalls #-}
visibleWalls sp ep =
    takeUntil (wlIsOpaque . snd)
        . sortOn (dist sp . fst)
        . overlapSegWalls sp ep
        . wlsNearSeg sp ep

allVisibleWalls :: World -> [(Point2, Wall)]
{-# INLINE allVisibleWalls #-}
allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 15
  where
    vPos = w ^. cWorld . camPos . camViewFrom

overlapCircWalls ::
    Point2 ->
    Float ->
    [Wall] ->
    [(Point2, Wall)]
{-# INLINE overlapCircWalls #-}
overlapCircWalls p r = 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
collideCircWalls :: Point2 -> Point2 -> Float -> [Wall] -> (Point2, Maybe Wall)
{-# INLINE collideCircWalls #-}
collideCircWalls sp ep rad = foldl' findPoint (ep, Nothing)
  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 -> [Wall] -> Maybe (Point2, Wall)
{-# INLINE overlapCircWallsClosest #-}
overlapCircWallsClosest p r =
    safeMinimumOn (dist p . fst)
        . overlapCircWalls p r

--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 =
    any (uncurry (circOnSeg p rad) . _wlLine)
        . wlsNearPoint p

--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 ^? cWorld . lWorld . 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 = w ^?! cWorld . lWorld . creatures . ix i . crPos -- _crPos (_creatures (_cWorld w) IM.! i)
    p2 = w ^?! cWorld . lWorld . creatures . ix j . crPos -- _crPos (_creatures (_cWorld w) IM.! j) -- unsafe

canSeeIndirect :: Int -> Int -> World -> Bool
{-# INLINE canSeeIndirect #-}
canSeeIndirect i j w = hasLOSIndirect ipos jpos w
  where
    ipos = w ^?! cWorld . lWorld . creatures . ix i . crPos
    jpos = w ^?! cWorld . lWorld . creatures . ix j . crPos

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

    hitWl = collideCircWalls sp ep rad $ wlsNearPoint ep w

-- this should probably be wallsOnLine or something