justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Start implementing wider grenade movement

Browse Source
This commit is contained in:
justin
2025-08-03 23:23:55 +01:00
parent ea2e67c9ab
commit 2a93b7f733
6 changed files with 200 additions and 146 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+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
src/Dodge/Data/Object.hs
+2
View File
@@ -11,3 +11,5 @@ data Object
= OPulseBall PulseBall
| OCreature Creature
| OWall Wall
| OFloor
| OChasmWall
src/Dodge/Projectile/Update.hs
+66 -41
View File
@@ -1,10 +1,9 @@
{-# LANGUAGE LambdaCase #-}
--{-# OPTIONS_GHC -Wno-unused-imports #-}
module Dodge.Projectile.Update (
updateProjectile,
) where
module Dodge.Projectile.Update (updateProjectile) where
import Dodge.Data.Object
import Control.Monad
import Data.List (delete)
import Data.Maybe
@@ -17,7 +16,7 @@ import Dodge.Payload
import Dodge.SoundLogic
import Dodge.WorldEvent.Cloud
import Dodge.WorldEvent.Sound
import Dodge.WorldEvent.ThingsHit
--import Dodge.WorldEvent.ThingsHit
import Geometry
import qualified IntMapHelp as IM
import LensHelp
@@ -27,7 +26,7 @@ import RandomHelp
updateProjectile :: Projectile -> World -> World
updateProjectile pj w =
(cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjTimer -~ 1)
. shellCollisionCheck pj
. shellExplosionCheck pj
. moveProjectile pj
$ doGravityPU pj w
@@ -66,25 +65,51 @@ applyGravityPU pj w
newz = pj ^. pjZ + pj ^. pjZVel
-- consider pushing any hit creature back
shellCollisionCheck :: Projectile -> World -> World
shellCollisionCheck pj w
shellExplosionCheck :: Projectile -> World -> World
shellExplosionCheck pj w
| RetiredProjectile <- pj ^. pjType
, time <= 0 =
destroyProjectile (pj ^. pjScreenID) (_pjID pj) w
| time <= 0 = explodeShell pj w
| RetiredProjectile <- pj ^. pjType = w
| Just thit <- thingHit oldpos (oldpos + _pjVel pj) w = tryShellBounce thit pj w
| otherwise = w
where
time = _pjTimer pj
oldpos = _pjPos pj
-- note this doesn't take into account moving walls, which may break the
-- bouncing in some way
tryShellBounce :: (Point2, Either Creature Wall) -> Projectile -> World -> World
tryShellBounce (p, Right wl) pj w
| Just GStuckCreature{} <- pj ^? pjType . gnHitEffect = w
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
---- note this doesn't take into account moving walls, which may break the
---- bouncing in some way
--tryShellBounce :: (Point2, Either Creature Wall) -> Projectile -> World -> World
--tryShellBounce (p, Right wl) pj w
-- | Just GStick <- pj ^? pjType . gnHitEffect =
-- w
-- & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
-- .~ Grenade (GStuckWall (wl ^. wlStructure))
-- & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
-- | Just x <- pj ^? pjType . gnHitEffect . bounceTolerance
-- , abs (dotV (pj ^. pjVel) (vNormal hitline)) < x =
-- w
-- & cWorld . lWorld . projectiles . ix (_pjID pj) . pjVel
-- %~ reflectIn hitline
-- & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos
-- .~ p - normalizeV (pj ^. pjVel)
-- & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
-- where
-- hitline = normalizeV $ uncurry (-) $ _wlLine wl
--tryShellBounce (p, Left cr) pj w
-- | Just GStick <- pj ^? pjType . gnHitEffect =
-- w
-- & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
-- .~ Grenade
-- ( GStuckCreature
-- (cr ^. crID)
-- (rotateV (- cr ^. crDir) (p - cr ^. crPos))
-- (pj ^. pjDir - cr ^. crDir)
-- )
-- & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
--tryShellBounce _ pj w = explodeShell pj w
tryShellBounce' :: Point3 -> (Point3, Object ) -> Projectile -> World -> World
tryShellBounce' p' (n, OWall wl) pj w
| Just GStick <- pj ^? pjType . gnHitEffect =
w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
@@ -98,13 +123,10 @@ tryShellBounce (p, Right wl) pj w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos
.~ p - normalizeV (pj ^. pjVel)
& soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
| isJust $ pj ^? pjType . gnHitEffect . bounceTolerance =
explodeShell pj w
where
p = xyV3 p'
hitline = normalizeV $ uncurry (-) $ _wlLine wl
tryShellBounce (p, Left cr) pj w
| Just GStuckCreature{} <- pj ^? pjType . gnHitEffect = w
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
tryShellBounce' p' (n,OCreature cr) pj w
| Just GStick <- pj ^? pjType . gnHitEffect =
w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
@@ -115,7 +137,10 @@ tryShellBounce (p, Left cr) pj w
(pj ^. pjDir - cr ^. crDir)
)
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
tryShellBounce _ pj w = explodeShell pj w
where
p = xyV3 p'
tryShellBounce' _ _ pj w = w
tryShellBounce' _ _ pj w = explodeShell pj w
destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World
destroyProjectile mitid pjid w =
@@ -130,11 +155,11 @@ destroyProjectile mitid pjid w =
trySpin :: Projectile -> World -> World
trySpin pj = fromMaybe id $ do
guard (pj ^. pjTimer == 335)
(cid,s) <- pj ^? pjBarrelSpin . _Just
(cid, s) <- pj ^? pjBarrelSpin . _Just
return $ doBarrelSpin cid s pj
tryThrust :: Projectile -> World -> World
tryThrust pj = fromMaybe id $ do
tryThrust pj = fromMaybe id $ do
Rocket y x <- pj ^? pjType
guard $ pj ^. pjTimer <= 330 && pj ^. pjTimer >= 0
return $ doThrust pj x . pjRemoteSetDirection (Just y) pj
@@ -145,9 +170,9 @@ doThrust pj smoke w =
& randGen .~ g
& cWorld . lWorld . projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
-- & makeFlamelet (oldPos -.- vel) (vel + 2 * rotateV (pi + sparkD) accel) 3 10
& makeFlamelet (oldPos -.- vel) (vel +.+ rotateV (pi + sparkD) accel) 3 10
& makeCloudAt RocketSmoke
& makeCloudAt
RocketSmoke
lifetime
(addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
where
@@ -155,7 +180,7 @@ doThrust pj smoke w =
lt
| smoke == Just ReducedRocketSmoke = (50, 200)
| otherwise = (300, 500)
-- trailfadetime = fst . randomR (100, 300) $ _randGen w
-- trailfadetime = fst . randomR (100, 300) $ _randGen w
accel = rotateV (pj ^. pjDir) (V2 3 0)
i = _pjID pj
oldPos = _pjPos pj
@@ -170,11 +195,12 @@ doThrust pj smoke w =
doBarrelSpin :: Int -> Float -> Projectile -> World -> World
doBarrelSpin cid i pj w =
w & cWorld . lWorld . projectiles . ix pjid . pjSpin .~ newSpin
& cWorld . lWorld . projectiles . ix pjid . pjBarrelSpin .~ Nothing
-- & cWorld . lWorld . projectiles . ix pjid . pjUpdates %~ deleteBy f (StartSpinPU 0 0 0)
& cWorld . lWorld . projectiles . ix pjid . pjBarrelSpin .~ Nothing
where
-- f _ StartSpinPU{} = True
-- f _ _ = False
-- & cWorld . lWorld . projectiles . ix pjid . pjUpdates %~ deleteBy f (StartSpinPU 0 0 0)
-- f _ StartSpinPU{} = True
-- f _ _ = False
pjid = _pjID pj
dir = argV $ _pjVel pj
newSpin = case w ^? cWorld . lWorld . creatures . ix cid of
@@ -207,20 +233,21 @@ pjRemoteSetDirection ph pj w = case ph of
moveProjectile :: Projectile -> World -> World
moveProjectile pj w
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
| Just (GStuckCreature crid p d) <- pj ^? pjType . gnHitEffect
| Just (GStuckCreature crid poff d) <- pj ^? pjType . gnHitEffect
, Just cr <- w ^? cWorld . lWorld . creatures . ix crid =
let cpos = cr ^. crPos
cdir = cr ^. crDir
vel = cpos - cr ^. crOldPos
in w
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos
.~ cpos + rotateV cdir p
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir
.~ d + cdir
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjVel
.~ vel
.~ cpos + rotateV cdir poff
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir .~ d + cdir
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjVel .~ vel
| Just GStuckCreature{} <- pj ^? pjType . gnHitEffect =
w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjType .~ Grenade GStick
-- | Just thit <- thingHit p (p + _pjVel pj) w = tryShellBounce thit pj w
| (p,Just po) <- collide3 (p `v2z` (_pjZ pj)) ((p + _pjVel pj)`v2z` (_pjZ pj + _pjZVel pj) ) w
= tryShellBounce' p po pj w
| otherwise =
w
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjSpin *~ 0.99
@@ -228,14 +255,12 @@ moveProjectile pj w
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir +~ _pjSpin pj
& tryThrust pj
& trySpin pj
where
p = _pjPos pj
explodeShell ::
Projectile ->
World ->
World
explodeShell :: Projectile -> World -> World
explodeShell pj w =
w
-- & cWorld . lWorld . projectiles . ix pjid . pjUpdates .~ []
& cWorld . lWorld . projectiles . ix pjid . pjType .~ RetiredProjectile
& cWorld . lWorld . projectiles . ix pjid . pjVel .~ 0
& cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 30
src/Dodge/Prop/Moving.hs
+2 -2
View File
@@ -22,11 +22,11 @@ updateDebrisChunk w db = (w, mdb)
sv = db ^. dbVel
sp = _dbPos db
np = sp + sv
cdb = case collide3 sp np w of
cdb = case collide3WallsFloor sp np w of
(p,Nothing) -> db & dbPos .~ p
& dbVel -~ V3 0 0 1
& dbRot %~ dospin
(p,Just n) -> db & dbPos .~ p + (0.0001 * normalize n)
(p,Just (n,_)) -> db & dbPos .~ p + (0.0001 * normalize n)
& dbVel .~ (0.7 * reflectInNormal n sv) - V3 0 0 1
dospin = (_dbSpin db *)
mdb = do