{-# 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
    , collidePointWallsFilterStream
    , collidePointTestFilter
    , overlapSegWalls
    , bounceBall
    , bouncePoint
    , sortStreamOn
    , minStreamOn
--    , wallsOnCirc
--    , wallsOnCirc'
    , wallsOnLineHit
    , collideCircWallsStream
    , collideCircWalls
    , circOnSomeWall
    , collidePointWallsNorm
    , collidePointWalls'
    , overlapCircWalls
    , overlapCircWallsClosest
    , collideCircCrsPoint
    , collideCircCreatures
    , collidePointCreatures
    , collidePointAnyWallsReflect
    , crsNearPoint
    , crsOnLine
    , crsOnThickLine
    , nearestCrInRad
    , nearestCrInTri
    , nearestCrInFront
    , allVisibleWalls

    , hasLOS
    , hasLOSIndirect
    , hasButtonLOS
    , canSee
    , canSeeIndirect
    , isWalkable
    ) where
import Dodge.Data
import Dodge.Zone
import Dodge.Base.Wall
import Geometry
import FoldableHelp

import Data.Maybe
import qualified Data.IntMap.Strict as IM
import Control.Lens
import Control.Monad
--import qualified FoldlHelp as L
import Data.Monoid
import StreamingHelp
import qualified Streaming.Prelude as S

collidePoint :: Point2 -> Point2 
    -> Stream (Of Wall) Identity ()
    -> (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

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

bounceBall :: Float -> Point2 -> Point2 -> Float 
    -> Stream (Of Wall) Identity ()
    -> Maybe (Point2,Point2)
bounceBall x sp ep r = doBounce x sp ep . collideCircWallsStream sp ep r

bouncePoint :: (Wall -> Bool) -> Float -> Point2 -> Point2 -> World -> Maybe (Point2,Point2)
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 -> Stream (Of Wall) Identity () -> Bool
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)
collidePointWallsFilterStream t sp ep = collidePoint sp ep
    . S.filter t
    . wallsAlongLine sp ep

overlapSegWalls :: Point2 -> Point2 -> Stream (Of Wall) Identity () 
    -> Stream (Of (Point2,Wall)) Identity ()
overlapSegWalls sp ep = S.mapMaybe $ \wl -> uncurry (intersectSegSeg sp ep) (_wlLine wl) <&> (,wl)

visibleWalls :: Point2 -> Point2 -> World -> Stream (Of (Point2,Wall)) Identity ()
visibleWalls sp ep = S.take 1 <=<  -- hlint, was using join and fmap
    ( S.span (not . wlIsOpaque . snd)
    . sortStreamOn (dist sp . fst)
    . overlapSegWalls sp ep
    . wallsAlongLine sp ep    )

allVisibleWalls :: World -> Stream (Of (Point2,Wall)) Identity ()
allVisibleWalls w = concats $ S.subst (flip (visibleWalls vPos) w . (+.+ vPos)) $ S.each (nRays 20)
  where
    vPos = _cameraViewFrom w

    
wallsOnLineHit :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap (Point2, Wall)
wallsOnLineHit p1 p2 = IM.mapMaybe f
  where
    f wl = uncurry (intersectSegSeg p1 p2) (_wlLine wl) <&> (, wl)

-- | Looks for any collision of a circle with walls.
-- If found, gives point and reflection velocity, reflection damped in normal.
-- note that in this version the circle can overlap the wall
collidePointAnyWallsReflect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
collidePointAnyWallsReflect p1 p2 
    = getFirst
    . foldMap (First . findPoint . _wlLine)
  where 
    findPoint (x,y) = case intersectSegSeg p1 p2 x y of
        Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1))
        Nothing -> Nothing

collidePointWalls' :: (Foldable t, Functor t) => Point2 -> Point2 -> t Wall -> Point2
{-# INLINE collidePointWalls' #-}
collidePointWalls' p1 p2 = foldl' findPoint p2 . fmap _wlLine
  where
    findPoint p = fromMaybe p . uncurry (intersectSegSeg p1 p)

overlapCircWalls :: Point2 -> Float -> Stream (Of Wall) Identity () 
    -> Stream (Of (Point2,Wall)) Identity ()
overlapCircWalls p r = S.mapMaybe dointersect
  where
    dointersect wl = f (_wlLine wl) <&> (,wl)
    f (a,b) = intersectSegSeg p (p -.- r *.* vNormal (normalizeV (a -.- b))) a b

-- note that this does not push the circle away from the wall at all
collideCircWallsStream :: Point2 -> Point2 -> Float -> Stream (Of Wall) Identity ()
    -> (Point2, Maybe Wall)
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 -> Stream (Of Wall) Identity () -> Maybe (Point2,Wall)
overlapCircWallsClosest p r = minStreamOn (dist p . fst)
    . overlapCircWalls p r

-- | Looks for first collision of a circle with walls.
-- If found, gives point and reflection velocity, reflection damped in normal.
collideCircWalls :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
collideCircWalls p1 p2 rad
    = safeMinimumOn (dist p1 . fst) 
    . IM.mapMaybe 
        (( \(x:y:_) -> fmap 
            ((, reflectInParam 0.5 (x -.- y) (p2 -.- p1)) 
            . (+.+ normalizeV (vNormal (x -.- y)))
            ) 
            (intersectSegSeg p1 p2 x y)
         ) 
         . shiftByRad . _wlLine
        )
  where 
    shiftByRad (a,b) = map ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
        [a +.+ rad *.* normalizeV (a -.-b)
        ,b +.+ rad *.* normalizeV (b -.-a)
        ]
-- this shifts the wall out, and for outer corners extends the wall
-- not sure what this does for inner corners, hopefully won't cause a problem
-- the alternative would be to separately bounce off corner points...
-- unfortunately, doesn't allow for collisions when the circle spawns on the
-- wall


-- | Looks for first collision of a point with walls.
-- If found, gives point and normal of wall.
collidePointWallsNorm :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
collidePointWallsNorm p1 p2 ws 
    = safeMinimumOn (dist p1 . fst)
    $ IM.mapMaybe (( \(x,y) -> intersectSegSeg p1 p2 x y <&> ( , vNormal $ x -.- y ) ) 
        . _wlLine) ws
-- | Returns the first creature, if any, that a point intersects with.
collidePointCreatures :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe Int
collidePointCreatures p1 p2 = fmap fst 
    . safeMinimumOn snd
    . IM.toList 
    . IM.mapMaybe (\x -> dist p1 <$> intersectCircSegFirst (_crPos x) (_crRad x) p1 p2) 
-- | As for 'collidePointCreatures', only increases the radius of creatures by a
--fixed amount, thus collides a moving circle with creaures.
collideCircCreatures :: Point2 -> Point2 -> Float -> IM.IntMap Creature -> Maybe Int
collideCircCreatures p1 p2 rad = collidePointCreatures p1 p2 . fmap (crRad +~ rad)

-- | Returns the first creature id, if any, that a point intersects with, gives point
--in creature on line.
collidePointCrsPoint :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe (Point2,Int)
collidePointCrsPoint p1 p2 = fmap f 
    . safeMinimumOn (dist p1 . snd)
    . IM.toList 
    . IM.mapMaybe (\x -> intersectCircSegFirst (_crPos x) (_crRad x) p1 p2) 
  where 
    f (cID,p) = (p,cID)
{- | Finds the first creature hit on a line.
Maybe evaluates the creature id and hit point. -}
collideCircCrsPoint :: Point2 -> Point2 -> Float -> IM.IntMap Creature -> Maybe (Point2,Int)
collideCircCrsPoint p1 p2 rad = collidePointCrsPoint p1 p2 . fmap (crRad +~ rad)

---- | Makes a creature not hittable.
--collidePointCrsWithoutPoint :: Int -> Point2 -> Point2 -> World -> Maybe (Point2,Int)
--collidePointCrsWithoutPoint cid p1 p2 w 
--    = fmap f 
--    . safeMinimumOn (snd . snd)
--    . IM.toList 
--    . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (_crRad x) (_crPos x)) 
--    . IM.delete cid 
--    $ _creatures w
--  where 
--    f (cID,(p,_)) = (p,cID)
{- | Test if a circle collides with any wall. 
 - Note no check on whether the wall is walkable. -}
circOnSomeWall :: Point2 -> Float -> World -> Bool
circOnSomeWall p rad = runIdentity . S.any_ (uncurry (circOnSeg p rad) . _wlLine)
    . wallsNearPoint p
--    = any (\(x,y) -> circOnSeg x y p rad) 
--    . fmap _wlLine 
--    . IM.elems 
--    . wallsNearPoint p

{- | Produce an unordered list of creatures on a line. -}
crsOnLine :: Point2 -> Point2 -> World -> IM.IntMap Creature
crsOnLine p1 p2
    = IM.filter (\cr -> segOnCirc p1 p2 (_crPos cr) (_crRad cr))
    . _creatures
{- | Produce an unordered list of creatures on a wide line. -}
crsOnThickLine :: Float -> Point2 -> Point2 -> World -> IM.IntMap Creature
crsOnThickLine thickness p1 p2
    = IM.filter (\cr -> segOnCirc p1 p2 (_crPos cr) (_crRad cr + thickness))
    . _creatures
{- | Find 'Maybe' the closest creature to a point, within a circle.
 -}
nearestCrInRad :: Point2 -> Float -> World -> Maybe Creature
nearestCrInRad p r
    = safeMinimumOn (dist p . _crPos)
    . IM.filter (\cr -> dist p (_crPos cr) < r) 
    . _creatures
{- | Find 'Maybe' the closest creature in front of a point in a right-angle-triangle shape.  -}
nearestCrInTri 
    :: Point2 
    -> Float    -- ^ Direction (radians +ve anticlockwise from x-axis).
    -> Float    -- ^ Distance. 
    -> World -> Maybe Creature
nearestCrInTri p dir x
    = safeMinimumOn (dist p . _crPos)
    . IM.filter (\cr -> pointInPolygon (_crPos cr) tri) 
    . _creatures
 where 
    tri = 
        [p 
        ,p +.+ rotateV (dir-pi/4) (V2 x 0)
        ,p +.+ rotateV (dir+pi/4) (V2 x 0)
        ]
{- | Find 'Maybe' the closes creature in front of a point in a given direction for
a given distance.
The shapes within which creatures are searched are a triangle then rectangle.  -}
nearestCrInFront 
    :: Point2
    -> Float    -- ^ Direction (radians +ve anticlockwise from x-axis).
    -> Float    -- ^ Distance.
    -> World -> Maybe Creature
nearestCrInFront p dir x
    = safeMinimumOn (dist p . _crPos)
    . IM.filter (\cr -> pointInPolygon (_crPos cr) rec)
    . _creatures
  where 
    rec = [p, pR, pR1, pL1, pL ]
    pR  = p +.+ rotateV (dir - pi*(3/8)) (V2 (x/2) 0)
    pL  = p +.+ rotateV (dir + pi*(3/8)) (V2 (x/2) 0)
    pR1 = pR +.+ rotateV dir (V2 (x/2) 0)
    pL1 = pL +.+ rotateV dir (V2 (x/2) 0)

{- | More general collision tests follow -}

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

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

hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
hasLOSIndirect p1 p2 = not
    . collidePointTestFilter wlIsOpaque p1 p2
    . wallsAlongLine p1 p2

isWalkable :: Point2 -> Point2 -> World -> Bool
isWalkable p1 p2 = not 
    . collidePointTestFilter (not . (^?! wlPathable)) p1 p2 
    . wallsAlongLine p1 p2

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)

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