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

Refactor, try to limit dependencies

Browse Source
This commit is contained in:
justin
2022-07-28 00:59:56 +01:00
parent 8aa5c17ab9
commit 160560af5f
418 changed files with 15104 additions and 13342 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Prop/Moving.hs
+37 -30
View File
@@ -1,15 +1,18 @@
module Dodge.Prop.Moving
( fallSmallBounceDamage
, fallSmallBounce
) where
module Dodge.Prop.Moving (
fallSmallBounceDamage,
fallSmallBounce,
) where
import Dodge.Base
import Dodge.Data
import Dodge.Data.World
import Geometry
import LensHelp
fallSmallBounceDamage :: Prop -> World -> World
fallSmallBounceDamage pr w = w
& dodamage
& cWorld . props . ix (_prID pr) %~ fallSmallBounce' w
fallSmallBounceDamage pr w =
w
& dodamage
& cWorld . props . ix (_prID pr) %~ fallSmallBounce' w
where
p = _prPos pr
v = _prVel pr
@@ -17,36 +20,40 @@ fallSmallBounceDamage pr w = w
| _prPosZ pr < 25 = cWorld . creatures %~ fmap dodamage'
| otherwise = id
dodamage' cr
| dist (_crPos cr) p < _crRad cr + 5 = cr & crState . csDamage
.:~ Damage CRUSHING (floor . (*10) . max 0 . subtract 5 . abs $ _prVelZ pr) (p -.- v) p (p +.+ v) NoDamageEffect
| dist (_crPos cr) p < _crRad cr + 5 =
cr & crState . csDamage
.:~ Damage CRUSHING (floor . (* 10) . max 0 . subtract 5 . abs $ _prVelZ pr) (p -.- v) p (p +.+ v) NoDamageEffect
| otherwise = cr
fallSmallBounce :: Prop -> World -> World
fallSmallBounce pr w = w
& cWorld . props . ix (_prID pr) %~ fallSmallBounce' w
fallSmallBounce pr w =
w
& cWorld . 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
| 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
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')
Just (p, v') -> (prPos .~ p) . (prVel .~ v')