Correct cloud movement
This commit is contained in:
+8
-24
@@ -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)
|
||||||
|
|||||||
Reference in New Issue
Block a user