{-# LANGUAGE TupleSections #-}

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

import ListHelp
import Control.Applicative
import Dodge.Wall.Pathing
--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

---- pushes out any hit point by one
wlHitPos :: Point2 -> Point2 -> World -> Point2
wlHitPos sp ep = maybe ep ((+ normalize (ep - sp)) . fst) . safeHead . wlsHit 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)
    f wl = mhp <&> (,wl)
      where
        (x,y) = wl ^. wlLine
        t mp = do
            p' <- mp
            guard (distance p p' < r) 
            mp
        orthp = t $ orthogonalPointOnSeg x y p
        mhp = orthp <|> t (return x) <|> t (return y)
--        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 . to getWallPathing)
        . wlsHitUnsorted p1 p2

isWalkable :: Point2 -> Point2 -> World -> Bool
{-# INLINE isWalkable #-}
isWalkable p1 p2 w = isFlyable p1 p2 w && not (any f (w ^. cWorld . cliffs))
  where
    f = isJust . uncurry (intersectSegSeg p1 p2)