69 lines
2.0 KiB
Haskell
69 lines
2.0 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
{- |
|
|
Find which objects lie upon a line.
|
|
-}
|
|
module Dodge.WorldEvent.ThingsHit
|
|
( thingsHit
|
|
, thingHit
|
|
, thingHitFilt
|
|
, thingsHitExceptCr
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Geometry
|
|
|
|
--import Data.Maybe
|
|
import Data.Bifunctor
|
|
import StreamingHelp
|
|
import qualified Streaming.Prelude as S
|
|
|
|
{- List those objects that appear on a line. -}
|
|
thingsHit
|
|
:: Point2 -- ^ Line start point
|
|
-> Point2 -- ^ Line end point
|
|
-> World
|
|
-> StreamOf (Point2, Either Creature Wall)
|
|
thingsHit sp ep w = void $ S.mergeOn (dist sp . fst)
|
|
(S.map (second Left) (crsHit sp ep w))
|
|
(S.map (second Right) (wlsHit sp ep w))
|
|
|
|
crsHit :: Point2 -> Point2 -> World -> StreamOf (Point2, Creature)
|
|
crsHit sp ep
|
|
| sp == ep = const mempty
|
|
| otherwise = sortStreamOn (dist sp . fst)
|
|
. overlap1SegCrs sp ep
|
|
. crsNearSeg sp ep
|
|
|
|
thingHitFilt :: (Creature -> Bool) -> (Wall -> Bool)
|
|
-> Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
|
|
thingHitFilt fcr fwl sp ep = runIdentity . S.head_ . S.filter (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 = runIdentity . S.head_ . thingsHit sp ep
|
|
|
|
{- List objects that appear on a line.
|
|
Can filter out a creature. -}
|
|
thingsHitExceptCr
|
|
:: Maybe Int -- ^ A possible creature ID
|
|
-> Point2 -- ^ Line start point
|
|
-> Point2 -- ^ Line end point
|
|
-> World
|
|
-> StreamOf (Point2, Either Creature Wall)
|
|
thingsHitExceptCr Nothing sp ep = thingsHit sp ep
|
|
thingsHitExceptCr (Just cid) sp ep = S.filter crNotCid . thingsHit sp ep
|
|
where
|
|
crNotCid (_,Left cr) = _crID cr /= cid
|
|
crNotCid _ = True
|
|
|
|
wlsHit :: Point2 -> Point2 -> World -> StreamOf (Point2, Wall)
|
|
wlsHit sp ep
|
|
| sp == ep = const mempty
|
|
| otherwise = sortStreamOn (dist sp . fst)
|
|
. overlapSegWalls sp ep
|
|
. wlsNearSeg sp ep
|