111 lines
2.9 KiB
Haskell
111 lines
2.9 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
|
|
{- |
|
|
Find which objects lie upon a line.
|
|
-}
|
|
module Dodge.WorldEvent.ThingsHit (
|
|
thingsHit,
|
|
thingHit,
|
|
thingHitFilt,
|
|
thingsHitExceptCr,
|
|
crsHitRadial,
|
|
wlsHitRadial,
|
|
crHit,
|
|
) where
|
|
|
|
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
|
|
|
|
{- List those objects that appear on a line. -}
|
|
thingsHit ::
|
|
-- | Line start point
|
|
Point2 ->
|
|
-- | Line end point
|
|
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))
|
|
|
|
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 . creatures . ix cid)
|
|
. IS.toList
|
|
. crixsNearSeg sp ep
|
|
$ w
|
|
|
|
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
|
|
|
|
{- 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 crNotCid . thingsHit sp ep
|
|
where
|
|
crNotCid (_, Left cr) = _crID cr /= cid
|
|
crNotCid _ = True
|
|
|
|
wlsHit :: Point2 -> Point2 -> World -> [(Point2, Wall)]
|
|
wlsHit sp ep
|
|
| sp == ep = const mempty
|
|
| otherwise =
|
|
sortOn (dist sp . fst)
|
|
. 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
|
|
| dist cpos p <= r = Just (cpos +.+ r *.* normalizeV (p -.- cpos), cr)
|
|
| otherwise = Nothing
|
|
where
|
|
cpos = _crPos cr
|