Files
loop/src/Dodge/Prop/Moving.hs
T
2025-06-20 21:57:07 +01:00

58 lines
1.6 KiB
Haskell

module Dodge.Prop.Moving (
fallSmallBounceDamage,
fallSmallBounce,
) where
import Dodge.Damage
import Dodge.Base
import Dodge.Data.World
import Geometry
import LensHelp
fallSmallBounceDamage :: Prop -> World -> World
fallSmallBounceDamage pr w =
w
& dodamage
& cWorld . lWorld . props . ix (_prID pr) %~ fallSmallBounce' w
where
p = _prPos pr
v = _prVel pr
dodamage
| _prPosZ pr < 25 = damageInCircle (const [thedam]) p 5
-- cWorld . lWorld . creatures . each %~ dodamage'
| 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) %~ fallSmallBounce' w
fallSmallBounce' :: World -> Prop -> Prop
fallSmallBounce' w pr
| newposz < 0 && velz < (-2) =
pr
& prVelZ %~ ((* 0.5) . negate)
-- & pjPos +~ (0.5*.* vel)
& updateWithVel (0.5 *.* vel)
& prVel %~ (0.5 *.*)
-- & pjPos +~ (0.5*.* vel)
| 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')