diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 37ec61875..4be866718 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -66,8 +66,8 @@ update' w = case _menuLayers w of . updateParticles . updateProjectiles . updateLightSources - . zoneClouds . updateClouds + . zoneClouds . updateCreatures . updateCreatureGroups . updateBlocks @@ -168,34 +168,18 @@ updateCloud :: World -> Cloud -> Maybe Cloud updateCloud w c | _clTimer c < 1 = Nothing | otherwise = Just $ c - & clPos %~ (+.+ newVel) - & clVel .~ newVel + & clPos .~ finalPos + & clVel .~ finalVel & clTimer -~ 1 where - newVel = 0.90 *.* springVels + newVel = 0.95 *.* springVels springVels = 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 ---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 a v b | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)