Correct cloud movement

This commit is contained in:
2021-07-21 13:17:50 +02:00
parent 7367fc8f09
commit e5bee30f5b
+8 -24
View File
@@ -66,8 +66,8 @@ update' w = case _menuLayers w of
. updateParticles . updateParticles
. updateProjectiles . updateProjectiles
. updateLightSources . updateLightSources
. zoneClouds
. updateClouds . updateClouds
. zoneClouds
. updateCreatures . updateCreatures
. updateCreatureGroups . updateCreatureGroups
. updateBlocks . updateBlocks
@@ -168,34 +168,18 @@ updateCloud :: World -> Cloud -> Maybe Cloud
updateCloud w c updateCloud w c
| _clTimer c < 1 = Nothing | _clTimer c < 1 = Nothing
| otherwise = Just $ c | otherwise = Just $ c
& clPos %~ (+.+ newVel) & clPos .~ finalPos
& clVel .~ newVel & clVel .~ finalVel
& clTimer -~ 1 & clTimer -~ 1
where where
newVel = 0.90 *.* springVels newVel = 0.95 *.* springVels
springVels = foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w) springVels = foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w)
oldPos = _clPos c oldPos = _clPos c
newPos = oldPos +.+ newVel
hitWl = collideCircWalls' oldPos newPos 5 $ wallsNearPoint newPos w
finalPos = maybe newPos fst hitWl
finalVel = maybe newVel snd hitWl
--updateCloud :: World -> Cloud -> World
--updateCloud w c
-- | _clTimer c < 1 = w & clouds %~ IM.delete (_clID c)
-- | otherwise = moveCloud c w
--
--moveCloud :: Cloud -> World -> World
--moveCloud c w = _clEffect c c . theUpdate $ w
-- where
-- newVel = 0.95 *.* springVels
-- springVels = IM.foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w)
-- oldPos = _clPos c
-- newPos = oldPos +.+ newVel
-- hitWl = collideCircWalls' oldPos newPos 5 $ wallsNearPoint newPos w
-- finalPos = maybe newPos fst hitWl
-- finalVel = maybe newVel snd hitWl
-- theUpdate w' = w'
-- & clouds . ix (_clID c) . clTimer %~ (\t -> t - 1)
-- & clouds . ix (_clID c) . clVel .~ finalVel
-- & clouds . ix (_clID c) . clPos .~ finalPos
--
clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2 clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2
clClSpringVel a v b clClSpringVel a v b
| dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb) | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)