Refactor crPos to be a V3

This commit is contained in:
2025-10-10 13:47:31 +01:00
parent 98ece551c7
commit 49fb982877
58 changed files with 375 additions and 307 deletions
+10 -11
View File
@@ -37,6 +37,7 @@ module Dodge.Base.Collide (
collide3,
) where
import Linear
import Control.Lens
import Control.Monad
import qualified Data.IntSet as IS
@@ -60,7 +61,7 @@ overlapSegCrs :: Point2 -> Point2 -> [Creature] -> [(Point2, Creature)]
{-# INLINE overlapSegCrs #-}
overlapSegCrs sp ep =
mapMaybe
(\cr -> (,cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (crRad $ cr ^. crType) sp ep))
(\cr -> (,cr) <$> listToMaybe (intersectCircSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType) sp ep))
doBounce :: Float -> Point2 -> Point2 -> (Point2, Maybe Wall) -> Maybe (Point2, Point2)
{-# INLINE doBounce #-}
@@ -125,7 +126,7 @@ collide3 sp ep w =
-- Just (hitpoint,normaltosurface)
collide3Walls :: Point3 -> World -> (Point3, MPO) -> (Point3, MPO)
collide3Walls sp w ex@(ep, _) = foldl' f ex wls
collide3Walls sp w e@(ep, _) = foldl' f e wls
where
f x wl = collide3Wall sp wl x
wls = wlsNearSeg (xyV3 sp) (xyV3 ep) w
@@ -153,14 +154,12 @@ collide3Creature :: Point3 -> Creature -> (Point3, MPO) -> (Point3, MPO)
collide3Creature sp cr (ep, m) = fromMaybe (ep, m) $ do
h <- crHeight cr
(p,n) <- fst $ intersectCylSeg
(addZ (cr ^. crZ) cpos)
(cr ^. crPos)
(crRad $ cr ^. crType)
h
sp
ep
return (p, Just (n,OCreature cr))
where
cpos = cr ^. crPos
crHeight :: Creature -> Maybe Float
crHeight cr = case cr ^. crHP of
@@ -288,7 +287,7 @@ circOnAnyCr :: Point2 -> Float -> World -> Bool
{-# INLINE circOnAnyCr #-}
circOnAnyCr p r w = IS.foldr f False $ crIXsNearPoint p w
where
f cid bl = maybe False (\cr -> dist p (_crPos cr) < r + crRad (cr ^. crType)) (w ^? cWorld . lWorld . creatures . ix cid) || bl
f cid bl = maybe False (\cr -> dist p (cr ^. crPos . _xy) < r + crRad (cr ^. crType)) (w ^? cWorld . lWorld . creatures . ix cid) || bl
-- | More general collision tests follow
hasLOS :: Point2 -> Point2 -> World -> Bool
@@ -325,15 +324,15 @@ canSee :: Int -> Int -> World -> Bool
{-# INLINE canSee #-}
canSee i j w = hasLOS p1 p2 w
where
p1 = w ^?! cWorld . lWorld . creatures . ix i . crPos -- _crPos (_creatures (_cWorld w) IM.! i)
p2 = w ^?! cWorld . lWorld . creatures . ix j . crPos -- _crPos (_creatures (_cWorld w) IM.! j) -- unsafe
p1 = w ^?! cWorld . lWorld . creatures . ix i . crPos . _xy -- _crPos (_creatures (_cWorld w) IM.! i)
p2 = w ^?! cWorld . lWorld . creatures . ix j . crPos . _xy -- _crPos (_creatures (_cWorld w) IM.! j) -- unsafe
canSeeIndirect :: Int -> Int -> World -> Bool
{-# INLINE canSeeIndirect #-}
canSeeIndirect i j w = hasLOSIndirect ipos jpos w
where
ipos = w ^?! cWorld . lWorld . creatures . ix i . crPos
jpos = w ^?! cWorld . lWorld . creatures . ix j . crPos
ipos = w ^?! cWorld . lWorld . creatures . ix i . crPos . _xy
jpos = w ^?! cWorld . lWorld . creatures . ix j . crPos . _xy
anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
anythingHitCirc rad sp ep w = hitCr || circHitWall sp ep rad w
@@ -345,7 +344,7 @@ anythingHitCirc rad sp ep w = hitCr || circHitWall sp ep rad w
f cid bl =
maybe
False
(\cr -> intersectCircSegTest (_crPos cr) (rad + crRad (cr ^. crType)) sp ep)
(\cr -> intersectCircSegTest (cr ^. crPos . _xy) (rad + crRad (cr ^. crType)) sp ep)
(w ^? cWorld . lWorld . creatures . ix cid)
|| bl