85 lines
3.2 KiB
Haskell
85 lines
3.2 KiB
Haskell
{- |
|
|
Find which objects lie upon a line.
|
|
-}
|
|
module Dodge.WorldEvent.ThingsHit
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Geometry
|
|
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Data.List
|
|
import Data.Maybe
|
|
{- List those objects that appear on a line. -}
|
|
thingsHit
|
|
:: Point2 -- ^ Line start point
|
|
-> Point2 -- ^ Line end point
|
|
-> World
|
|
-> [(Point2, Either3 Creature Wall ForceField)]
|
|
thingsHit sp ep w
|
|
| sp == ep = []
|
|
| otherwise = sortOn (dist sp . fst) (crs ++ wls ++ ffs)
|
|
where
|
|
hitCrs = IM.elems
|
|
$ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
|
|
$ _creatures w
|
|
-- $ creaturesAlongLine sp ep w
|
|
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
|
|
crs = zip crPs (map E3x1 hitCrs)
|
|
hitWls = wallsOnLine sp ep (IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1]
|
|
, b<-[y-1,y,y+1]])
|
|
(x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
|
|
f i m = case IM.lookup i m of
|
|
Just val -> val
|
|
_ -> IM.empty
|
|
wls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
|
|
hitPoint w' = uncurry (intersectSegSeg' sp ep) (_wlLine w')
|
|
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
|
|
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
|
|
{- 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, Either3 Creature Wall ForceField)]
|
|
thingsHitExceptCr Nothing sp ep = thingsHit sp ep
|
|
thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
|
|
where
|
|
crNotCid (_,E3x1 cr) = _crID cr /= cid
|
|
crNotCid _ = True
|
|
|
|
thingsHitExceptCrLongLine
|
|
:: Maybe Int
|
|
-> Point2
|
|
-> Point2
|
|
-> World
|
|
-> [(Point2, Either3 Creature Wall ForceField)]
|
|
thingsHitExceptCrLongLine Nothing sp ep = thingsHitLongLine sp ep
|
|
thingsHitExceptCrLongLine (Just cid) sp ep = filter crNotCid . thingsHitLongLine sp ep
|
|
where
|
|
crNotCid (_,E3x1 cr) = _crID cr /= cid
|
|
crNotCid _ = True
|
|
|
|
thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either3 Creature Wall ForceField)]
|
|
thingsHitLongLine sp ep w
|
|
| sp == ep = []
|
|
| otherwise = sortOn (dist sp . fst) (crs ++ wls ++ ffs)
|
|
where
|
|
crs = zip crPs (map E3x1 hitCrs)
|
|
hitCrs = IM.elems
|
|
. IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
|
|
$ _creatures w
|
|
-- $ creaturesAlongLine sp ep w
|
|
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
|
|
wls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
|
|
hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
|
|
hitPoint wl = uncurry (intersectSegSeg' sp ep) (_wlLine wl)
|
|
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
|
|
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
|
|
|
|
thingsHitOnPath :: [Point2] -> World -> [ [ ( Point2, Either3 Creature Wall ForceField ) ] ]
|
|
thingsHitOnPath [] _ = error "tried to find thingsHitOnPath containing no points"
|
|
thingsHitOnPath ps w = zipWith (\ a b -> thingsHit a b w) ps $ tail ps
|