97 lines
2.9 KiB
Haskell
97 lines
2.9 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
{- |
|
|
Find which objects lie upon a line.
|
|
-}
|
|
module Dodge.WorldEvent.ThingsHit
|
|
( thingsHit
|
|
, wallsHit
|
|
, thingHit
|
|
, thingsHitLongLine
|
|
, thingsHitExceptCr
|
|
, thingsHitExceptCrLongLine
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Geometry
|
|
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Data.List
|
|
import Data.Maybe
|
|
import Data.Bifunctor
|
|
{- List those objects that appear on a line. -}
|
|
thingsHit
|
|
:: Point2 -- ^ Line start point
|
|
-> Point2 -- ^ Line end point
|
|
-> World
|
|
-> [(Point2, Either Creature Wall)]
|
|
thingsHit sp ep w
|
|
| sp == ep = []
|
|
| otherwise = sortOn (dist sp . fst) (crs ++ wls)
|
|
where
|
|
crs = mapMaybe
|
|
(\cr -> (,Left cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep))
|
|
. IM.elems
|
|
$ _creatures w
|
|
wls = map (second Right) . IM.elems $ wallsOnLineHit sp ep
|
|
$ IM.unions [f b $ f a $ _znObjects $ _wallsZone w
|
|
| a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
|
|
(x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
|
|
f i = fromMaybe IM.empty . IM.lookup i
|
|
thingHit :: Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
|
|
thingHit sp ep = listToMaybe . 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
|
|
-> [(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
|
|
|
|
wallsHit
|
|
:: Point2 -- ^ Line start point
|
|
-> Point2 -- ^ Line end point
|
|
-> World
|
|
-> [(Point2, Wall)]
|
|
wallsHit sp ep w
|
|
| sp == ep = []
|
|
| otherwise = sortOn (dist sp . fst) wls
|
|
where
|
|
wls = IM.elems $ wallsOnLineHit sp ep
|
|
$ IM.unions [f b $ f a $ _znObjects $ _wallsZone w
|
|
| a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
|
|
-- $ _walls w
|
|
(x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
|
|
f i = fromMaybe IM.empty . IM.lookup i
|
|
|
|
thingsHitExceptCrLongLine
|
|
:: Maybe Int
|
|
-> Point2
|
|
-> Point2
|
|
-> World
|
|
-> [(Point2, Either Creature Wall)]
|
|
thingsHitExceptCrLongLine Nothing sp ep = thingsHitLongLine sp ep
|
|
thingsHitExceptCrLongLine (Just cid) sp ep = filter crNotCid . thingsHitLongLine sp ep
|
|
where
|
|
crNotCid (_,Left cr) = _crID cr /= cid
|
|
crNotCid _ = True
|
|
|
|
thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either Creature Wall)]
|
|
thingsHitLongLine sp ep w
|
|
| sp == ep = []
|
|
| otherwise = sortOn (dist sp . fst) (crs ++ wls)
|
|
where
|
|
crs = mapMaybe
|
|
(\cr -> (,Left cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep))
|
|
. IM.elems
|
|
$ _creatures w
|
|
-- $ creaturesAlongLine sp ep w
|
|
wls = map (second Right) . IM.elems $ wallsOnLineHit sp ep $ _walls w
|