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

Start simplifying projectile update

Browse Source
This commit is contained in:
justin
2025-08-03 13:46:20 +01:00
parent 5f158cc87a
commit c3b2bb30f5
10 changed files with 218 additions and 228 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Projectile.hs
+3 -3
View File
@@ -33,9 +33,9 @@ data Projectile = Shell
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data ProjectileUpdate
= ThrustPU {_pjuStart :: Int, _pjuEnd :: Int}
| StartSpinPU {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
| RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int}
= --ThrustPU {_pjuStart :: Int, _pjuEnd :: Int}
StartSpinPU {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
-- | RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int}
deriving (Show, Eq, Ord, Read) --Generic, Flat)
data ProjectileType
src/Dodge/Data/Prop.hs
+2 -4
View File
@@ -68,10 +68,8 @@ data PropDraw
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data PropUpdate
= PropUpdateAnd PropUpdate PropUpdate
| PropFallSmallBounceDamage
| PropFallSmallBounce
| PropUpdateId
= PropUpdateId
| PropUpdateAnd PropUpdate PropUpdate
| PropRotate Float
| PropSetToggleAnd WdBl PropUpdate
| PropUpdates [PropUpdate]
src/Dodge/Projectile/Create.hs
+2 -8
View File
@@ -48,9 +48,8 @@ createShell (p,q) mdetonator mscreen stab pjtype payload muz cr w =
, _pjTimer = lifespan
, _pjUpdates =
anyspin
<> [ RemoteDirectionPU (lifespan - thrustdelay) 0
]
<> thrustorgrav
-- <> [ RemoteDirectionPU 330 0
-- ]
, _pjType = pjtype
, _pjDetonatorID = mdetonator
, _pjScreenID = mscreen
@@ -72,11 +71,6 @@ createShell (p,q) mdetonator mscreen stab pjtype payload muz cr w =
Rocket{} -> 1
RetiredProjectile -> 0
lifespan = 350
thrustorgrav = case pjtype of
Grenade{} -> []
Rocket{} -> [ThrustPU (lifespan - thrustdelay) 0]
RetiredProjectile -> []
thrustdelay = 20
updatedetonator = fromMaybe id $ do
screenid <- mdetonator
return $
src/Dodge/Projectile/Update.hs
+13 -8
View File
@@ -5,6 +5,7 @@ module Dodge.Projectile.Update (
updateProjectile,
) where
import Control.Monad
import Data.Foldable
import Data.List (delete, deleteBy)
import Data.Maybe
@@ -34,18 +35,15 @@ updateProjectile pj w =
upProjectile :: Projectile -> ProjectileUpdate -> World -> World
upProjectile pj = \case
ThrustPU st et
| act st et -> doThrust pj (pj ^? pjType . rkSmoke . _Just)
| otherwise -> id
StartSpinPU t cid spinamount
| time == t -> trySpinByCID cid spinamount pj
| otherwise -> id
RemoteDirectionPU st et
| act st et -> pjRemoteSetDirection (pj ^? pjType . rkHoming) pj
| otherwise -> id
-- RemoteDirectionPU st et
-- | act st et -> pjRemoteSetDirection (pj ^? pjType . rkHoming) pj
-- | otherwise -> id
where
time = _pjTimer pj
act st et = time <= st && time >= et
-- act st et = time <= st && time >= et
doGravityPU :: Projectile -> World -> World
doGravityPU pj
@@ -143,6 +141,12 @@ destroyProjectile mitid pjid w =
loc <- w ^? cWorld . lWorld . itemLocations . ix itid
return $ pointerToItemLocation loc . itUse . uaParams . apProjectiles %~ delete pjid
tryThrust :: Projectile -> World -> World
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
doThrust :: Projectile -> Maybe RocketSmoke -> World -> World
doThrust pj smoke w =
w
@@ -184,7 +188,7 @@ trySpinByCID cid i pj w =
& cWorld . lWorld . projectiles . ix pjid . pjUpdates %~ deleteBy f (StartSpinPU 0 0 0)
where
f _ StartSpinPU{} = True
f _ _ = False
-- f _ _ = False
pjid = _pjID pj
dir = argV $ _pjVel pj
newSpin = case w ^? cWorld . lWorld . creatures . ix cid of
@@ -237,6 +241,7 @@ moveProjectile pj w
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos +~ _pjVel pj
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir
+~ (_pjSpin pj * _pjSpinFactor pj)
& tryThrust pj
explodeShell ::
Projectile ->
src/Dodge/Prop/Gib.hs
+9
View File
@@ -2,6 +2,7 @@ module Dodge.Prop.Gib (
addCrGibs,
) where
import Dodge.WorldEvent.Cloud
import Dodge.Creature.Shape
import Color
import Control.Monad
@@ -20,10 +21,18 @@ addCrGibs cr = case damageDirection $ _crDamage cr of
addGibAt 25 (_skinHead skin) cpos
. addGibsAtDir pi 0 3 7 (_skinLower skin) cpos
. addGibsAtDir pi 0 13 20 (_skinUpper skin) cpos
. makeDustAt Flesh 50 (addZ 20 cpos)
. makeDustAt Flesh 50 (addZ 20 cpos)
. makeDustAt Flesh 50 (addZ 20 cpos)
. makeDustAt Flesh 50 (addZ 20 cpos)
Just d -> (testFloat +~ 1)
. addGibsAtDir (pi/4) d 3 7 (_skinLower skin) cpos
. addGibsAtDir (pi/4) d 13 20 (_skinUpper skin) cpos
. addGibAtDir d 25 (_skinHead skin) cpos
. makeDustAt Flesh 50 (addZ 20 cpos)
. makeDustAt Flesh 50 (addZ 20 cpos)
. makeDustAt Flesh 50 (addZ 20 cpos)
. makeDustAt Flesh 50 (addZ 20 cpos)
where
skin = crShape $ _crType cr -- this should be cleaned up
cpos = _crPos cr
src/Dodge/Prop/Moving.hs
+43 -43
View File
@@ -1,12 +1,12 @@
module Dodge.Prop.Moving (
fallSmallBounceDamage,
fallSmallBounce,
-- fallSmallBounceDamage,
-- fallSmallBounce,
updateDebrisChunk,
) where
import Linear.Metric
import Linear.V3
import Dodge.Damage
--import Dodge.Damage
import Dodge.Base
import Dodge.Data.World
import Geometry
@@ -30,47 +30,47 @@ updateDebrisChunk w db = (w, mdb)
& dbVel .~ (0.7 * reflectInNormal n sv) - V3 0 0 1
dospin = (_dbSpin db *)
mdb = do
guard (np ^. _z > -100)
guard (np ^. _z > -1000)
return cdb'
fallSmallBounceDamage :: Prop -> World -> World
fallSmallBounceDamage pr w =
w
& dodamage
& cWorld . lWorld . props . ix (_prID pr) %~ fallMovement w
where
p = _prPos pr
v = _prVel pr
dodamage
| _prPosZ pr < 25 = damageInCircle (const thedam) p 5
| otherwise = id
thedam = Crushing (floor . (* 10) . max 0 . subtract 5 . abs $ _prVelZ pr) v
--fallSmallBounceDamage :: Prop -> World -> World
--fallSmallBounceDamage pr w =
-- w
-- & dodamage
-- & cWorld . lWorld . props . ix (_prID pr) %~ fallMovement w
-- where
-- p = _prPos pr
-- v = _prVel pr
-- dodamage
-- | _prPosZ pr < 25 = damageInCircle (const thedam) p 5
-- | otherwise = id
-- thedam = Crushing (floor . (* 10) . max 0 . subtract 5 . abs $ _prVelZ pr) v
fallSmallBounce :: Prop -> World -> World
fallSmallBounce pr w = w & cWorld . lWorld . props . ix (_prID pr) %~ fallMovement w
--fallSmallBounce :: Prop -> World -> World
--fallSmallBounce pr w = w & cWorld . lWorld . props . ix (_prID pr) %~ fallMovement w
fallMovement :: World -> Prop -> Prop
fallMovement w pr
| newposz < 0 && velz < (-2) =
pr
& prVelZ %~ ((* 0.5) . negate)
& updateWithVel (0.5 *.* vel)
& prVel %~ (0.5 *.*)
| newposz < 0 =
pr & prUpdate .~ PropUpdateId
& prPosZ .~ 0
-- & pjQuat *~ (_pjQuatSpin pr)
| otherwise =
pr
& prVelZ -~ 1
& prPosZ +~ velz
& updateWithVel vel
& prQuat *~ _prQuatSpin pr
where
newposz = _prPosZ pr + velz
velz = _prVelZ pr
vel = _prVel pr
pos = _prPos pr
updateWithVel v = case bouncePoint (const True) 0.5 pos (pos + v) w of
Nothing -> prPos +~ v
Just (p, v') -> (prPos .~ p) . (prVel .~ v')
--fallMovement :: World -> Prop -> Prop
--fallMovement w pr
-- | newposz < 0 && velz < (-2) =
-- pr
-- & prVelZ %~ ((* 0.5) . negate)
-- & updateWithVel (0.5 *.* vel)
-- & prVel %~ (0.5 *.*)
-- | newposz < 0 =
-- pr & prUpdate .~ PropUpdateId
-- & prPosZ .~ 0
-- -- & pjQuat *~ (_pjQuatSpin pr)
-- | otherwise =
-- pr
-- & prVelZ -~ 1
-- & prPosZ +~ velz
-- & updateWithVel vel
-- & prQuat *~ _prQuatSpin pr
-- where
-- newposz = _prPosZ pr + velz
-- velz = _prVelZ pr
-- vel = _prVel pr
-- pos = _prPos pr
-- updateWithVel v = case bouncePoint (const True) 0.5 pos (pos + v) w of
-- Nothing -> prPos +~ v
-- Just (p, v') -> (prPos .~ p) . (prVel .~ v')
src/Dodge/Prop/Update.hs
+1 -3
View File
@@ -4,14 +4,12 @@ import Control.Lens
import Data.Foldable
import Dodge.Data.World
import Dodge.PrWdLsLs
import Dodge.Prop.Moving
--import Dodge.Prop.Moving
import Dodge.WdP2f
import Dodge.WorldBool
updateProp :: Prop -> World -> World
updateProp pr = case _prUpdate pr of
PropFallSmallBounceDamage -> fallSmallBounceDamage pr
PropFallSmallBounce -> fallSmallBounce pr
PropUpdateId -> id
PropRotate x -> rotateProp x pr
PropSetToggleAnd wb pu -> propSetToggleAnd wb pu pr
src/Dodge/Update.hs
+1 -3
View File
@@ -521,9 +521,7 @@ tmUpdate tm w = case w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmFuture
pointTermParams = cWorld . lWorld . terminals . ix (_tmID tm)
setOldPos :: Creature -> Creature
setOldPos cr =
cr
& crOldPos .~ _crPos cr
setOldPos cr = cr & crOldPos .~ _crPos cr
-- hack
--updateRandGen :: World -> World