{-# LANGUAGE TupleSections #-}

{- |
Find which objects lie upon a line.
-}
module Dodge.WorldEvent.ThingsHit (
    thingsHit,
    thingsHitZ,
    thingHit,
    thingHitFilt,
    thingsHitExceptCr,
    crsHitRadial,
    wlsHitRadial,
    crHit,
    crWlPbHit,
    wlsHitUnsorted,
    isWalkable,
) where

import Data.Monoid
import qualified Data.Set as S
import Linear
import Dodge.Data.Object
import Dodge.Creature.Radius
import Control.Monad
import Control.Lens
import Data.Bifunctor
import qualified Data.IntSet as IS
import Data.List (sortOn)
import Data.Maybe
import Dodge.Base
import Dodge.Data.World
import Dodge.Zoning.Creature
import Dodge.Zoning.Wall
import Geometry
import qualified ListHelp as List
import qualified Data.IntMap.Strict as IM

{- List those objects that appear on a line.  -}
thingsHit :: Point2 -> Point2 -> World -> [(Point2, Either Creature Wall)]
thingsHit sp ep w =
    List.mergeOn
        (dist sp . fst)
        (map (second Left) (crsHit sp ep w))
        (map (second Right) (wlsHit sp ep w))

{- Does not hit corpses -}
thingsHitZ :: Float -> Point2 -> Point2 -> World -> [(Point2, Either Creature Wall)]
thingsHitZ z sp ep w =
    List.mergeOn
        (dist sp . fst)
        (map (second Left) (crsHitZ z sp ep w))
        (map (second Right) (wlsHit sp ep w))

crWlPbHit :: Point2 -> Point2 -> World -> [(Point2, Object)]
crWlPbHit sp ep w =
    List.mergeOn
        (dist sp . fst)
        (map (fmap toobj) (thingsHit sp ep w))
        (map (fmap OPulseBall) (pbsHit sp ep w))
  where
    toobj (Left cr) = OCreature cr
    toobj (Right wl) = OWall wl

crsHit :: Point2 -> Point2 -> World -> [(Point2, Creature)]
crsHit sp ep w
    | sp == ep = mempty
    | otherwise =
        sortOn (dist sp . fst)
            . overlapSegCrs sp ep
            . mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid)
            . IS.toList
            . crixsNearSeg sp ep
            $ w

crsHitZ :: Float -> Point2 -> Point2 -> World -> [(Point2, Creature)]
crsHitZ z sp ep w
    | sp == ep = mempty
    | otherwise =
        sortOn (dist sp . fst)
            . overlapSegCrs sp ep
            . mapMaybe (\cid -> f =<< w ^? cWorld . lWorld . creatures . ix cid)
            . IS.toList
            . crixsNearSeg sp ep
            $ w
  where
    f cr
        | HP{} <- cr ^. crHP = Just cr
        | CrIsCorpse{} <- cr ^. crHP
            , z < 5 = Just cr
        | otherwise = Nothing

pbsHit :: Point2 -> Point2 -> World -> [(Point2, PulseBall)]
pbsHit sp ep w
    | sp == ep = mempty
    | otherwise =
        sortOn (dist sp . fst)
            . mapMaybe (\pb -> (,pb) <$> fst (intersectCircSeg (_pbPos pb) 8 sp ep))
            . IM.elems
            $ w ^. cWorld . lWorld . pulseBalls

thingHitFilt ::
    (Creature -> Bool) ->
    (Wall -> Bool) ->
    Point2 ->
    Point2 ->
    World ->
    Maybe (Point2, Either Creature Wall)
thingHitFilt fcr fwl sp ep = List.find (f . snd) . thingsHit sp ep
  where
    f (Left cr) = fcr cr
    f (Right wl) = fwl wl

thingHit :: Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
thingHit sp ep = listToMaybe . thingsHit sp ep

crHit :: Point2 -> Point2 -> World -> Maybe (Point2,Creature)
--crHit sp ep = listToMaybe . sortOn (dist sp . fst) . crsHit sp ep
crHit sp ep = listToMaybe . crsHit sp ep

{- List objects that appear on a line.
Can filter out a creature.  -}
thingsHitExceptCr ::
    -- | A possible creature ID
    Maybe Int ->
    -- | Line start point
    Point2 ->
    -- | Line end point
    Point2 ->
    World ->
    [(Point2, Either Creature Wall)]
thingsHitExceptCr Nothing sp ep = thingsHit sp ep
thingsHitExceptCr (Just cid) sp ep = filter t . thingsHit sp ep
  where
    t = (Just cid /=) . (^? _2 . _Left . crID)

wlsHit :: Point2 -> Point2 -> World -> [(Point2, Wall)]
wlsHit sp ep = sortOn (dist sp . fst) . wlsHitUnsorted sp ep

wlsHitUnsorted :: Point2 -> Point2 -> World -> [(Point2, Wall)]
wlsHitUnsorted sp ep
    | sp == ep = const mempty
    | otherwise =
            overlapSegWalls sp ep
            . wlsNearSeg sp ep

wlsHitRadial :: Point2 -> Float -> World -> [(Point2, Wall)]
wlsHitRadial p r = mapMaybe f . wlsNearCirc p r
  where
    f wl = uncurry (intersectSegSeg p (p - r *.* v)) (_wlLine wl) <&> (,wl)
      where
        v = normalizeV . vNormal . uncurry (-) $ _wlLine wl

crsHitRadial :: Point2 -> Float -> World -> [(Point2, Creature)]
crsHitRadial p r = mapMaybe f . crsNearCirc p r
  where
    f cr = do
        let cp = cr ^. crPos . _xy
        guard $ dist p cp < r + crRad (_crType cr)
        return (cp + (1 + crRad (_crType cr)) *.* (cp - p), cr)

isFlyable :: Point2 -> Point2 -> World -> Bool
{-# INLINE isFlyable #-}
isFlyable p1 p2 =
    not . (WallNotAutoOpen `S.member`) 
        . foldMap (^. _2 . wlPathFlag)
        . wlsHitUnsorted p1 p2

isWalkable :: Point2 -> Point2 -> World -> Bool
{-# INLINE isWalkable #-}
isWalkable p1 p2 w = isFlyable p1 p2 w && not (getAny $ foldMap f (w ^. cWorld . chasms))
  where
    f = foldMap (Any . isJust . uncurry (intersectSegSeg p1 p2)) . loopPairs