Start implementing wider grenade movement

This commit is contained in:
2025-08-03 23:23:55 +01:00
parent ea2e67c9ab
commit 2a93b7f733
6 changed files with 200 additions and 146 deletions
+48 -19
View File
@@ -33,10 +33,11 @@ module Dodge.Base.Collide (
canSeeIndirect,
isWalkable,
anythingHitCirc,
collide3WallsFloor,
collide3,
) where
--import qualified Data.IntMap.Strict as IM
import Dodge.Data.Object
import Control.Monad
import Dodge.Creature.Radius
import Control.Lens
@@ -48,6 +49,7 @@ import Dodge.Data.World
import Dodge.Zoning
import FoldableHelp
import Geometry
import Linear.Metric
collidePoint :: Point2 -> Point2 -> [Wall] -> (Point2, Maybe Wall)
{-# INLINE collidePoint #-}
@@ -83,36 +85,63 @@ bouncePoint :: (Wall -> Bool) -> Float -> Point2 -> Point2 -> World -> Maybe (Po
{-# INLINE bouncePoint #-}
bouncePoint t x sp ep = doBounce x sp ep . collidePointWallsFilter t sp ep
collide3 :: Point3 -> Point3 -> World -> (Point3, Maybe Point3)
collide3 sp ep w = collide3Floors sp (w ^. cWorld . chasms)
type MPO = Maybe (Point3,Object)
collide3WallsFloor :: Point3 -> Point3 -> World -> (Point3, MPO)
collide3WallsFloor sp ep w = collide3Floors sp (w ^. cWorld . chasms)
$ collide3Walls sp w (ep,Nothing)
-- Just (hitpoint,normaltosurface)
collide3Walls :: Point3 -> World -> (Point3, Maybe Point3) -> (Point3, Maybe Point3)
collide3Walls sp w (ep,mn) = collide3Part sp wsfs (ep,mn)
collide3 :: Point3 -> Point3 -> World -> (Point3,MPO)
collide3 sp ep w = foldl' (flip $ collide3Creature sp) (p,m)
$ crsNearSeg (xyV3 sp) (xyV3 p) w
where
wsfs = f <$> wlsNearSeg (xyV3 sp) (xyV3 ep) w
f wl = (g x, g $ vNormal (x-y), [(g x,g (y-x)),(g y,g (x-y))])
where
g = (`v2z` 0)
(x,y) = _wlLine wl
(p,m) = collide3WallsFloor sp ep w
collide3Floors :: Point3 -> [[Point2]] -> (Point3, Maybe Point3) -> (Point3, Maybe Point3)
collide3Floors sp cs (ep,mn) = maybe (ep,mn) (,Just (V3 0 0 1)) mp
-- Just (hitpoint,normaltosurface)
collide3Walls :: Point3 -> World -> (Point3, MPO) -> (Point3, MPO)
collide3Walls sp w ex@(ep,_) = foldl' f ex wls
where
f x wl = collide3Wall sp wl x
wls = wlsNearSeg (xyV3 sp) (xyV3 ep) w
collide3Floors :: Point3 -> [[Point2]] -> (Point3, Maybe (Point3,Object))
-> (Point3, Maybe (Point3,Object))
collide3Floors sp cs (ep,mn) = maybe (ep,mn) (,Just (V3 0 0 1,OFloor)) mp
where
mp = do
V3 x y z <- intersectSegPlane sp ep (V3 0 0 0) (V3 0 0 1)
let g (a,b) = isRHS a b (V2 x y)
f = any g
guard (all (f . loopPairs) cs)
return $ V3 x y z
return $ (V3 x y z)
collide3Part :: Point3 -> [(Point3,Point3,[(Point3,Point3)])]
-> (Point3, Maybe Point3)
-> (Point3, Maybe Point3)
collide3Part sp = flip $ foldl' findPoint
collide3Wall :: Point3 -> Wall -> (Point3, MPO) -> (Point3, MPO)
collide3Wall sp wl (ep,mo) = maybe (ep,mo) (,Just (n,OWall wl)) $ intersectSegSurface sp ep p n ss
where
findPoint (x,mn) (p,n,ss) = maybe (x,mn) (,Just n) $ intersectSegSurface sp x p n ss
(p,n,ss) = wallToSurface wl
collide3Creature :: Point3 -> Creature -> (Point3, MPO) -> (Point3, MPO)
collide3Creature sp cr (ep,m) = fromMaybe (ep,m) $ do
(sp',ep') <- restrictSeg 0 (V3 0 0 1) (sp,ep) >>= restrictSeg (V3 0 0 25) (V3 0 0 (-1))
p <- listToMaybe $ intersectCircSeg cpos (crRad $ cr ^. crType) (xyV3 sp') (xyV3 ep')
let z = 0
return (p `v2z` z,Just (normalize $ (p - cpos) `v2z` 0, OCreature cr))
where
cpos = cr ^. crPos
restrictSeg :: Point3 -> Point3 -> (Point3,Point3) -> Maybe (Point3,Point3)
restrictSeg p n (sp,ep)
| isNHS p n sp
, isNHS p n ep = Just (sp,ep)
| isNHS p n sp = (sp,) <$> intersectSegPlane sp ep p n
| otherwise = (,ep) <$> intersectSegPlane sp ep p n
-- note if both sp & ep are not NHS, this returns Nothing
wallToSurface :: Wall -> (Point3,Point3,[(Point3,Point3)])
wallToSurface wl = (g x, g $ vNormal (x-y), [(g x,g (y-x)),(g y,g (x-y))])
where
g = (`v2z` 0)
(x,y) = _wlLine wl
-- this COULD be written in terms of collidePointWallsFilterStream, TODO test
-- whether this is actually faster