Attempt to reimplement cloud springs

src/Dodge/Update.hs

@@ -80,7 +80,7 @@ update' w = case _menuLayers w of
       where 
         (x,y) = crZoneOfPoint $ _crPos cr
         cid = _crID cr
-    zoneClouds = set cloudsZone (foldr cloudInZone IM.empty (_clouds w))
+    zoneClouds = set cloudsZone (foldl' (flip cloudInZone) IM.empty (_clouds w))
     cloudInZone cl = insertInZoneWith x y (++) [cl]
       where 
         (x,y) = cloudZoneOfPoint $ _clPos cl
@@ -161,9 +161,21 @@ checkEndGame w
     | otherwise         = w
 
 updateClouds :: World -> World
-updateClouds w = w
+updateClouds w = w & clouds %~ mapMaybe (updateCloud w)
 --updateClouds w = IM.foldl' updateCloud w $ _clouds w 
 
+updateCloud :: World -> Cloud -> Maybe Cloud
+updateCloud w c
+    | _clTimer c < 1 = Nothing
+    | otherwise = Just $ c 
+        & clPos %~ (+.+ newVel)
+        & clVel .~ newVel
+        & clTimer -~ 1
+  where
+    newVel = 0.90 *.* springVels
+    springVels = foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w)
+    oldPos = _clPos c
+
 --updateCloud :: World -> Cloud -> World
 --updateCloud w c
 --    | _clTimer c < 1 = w & clouds %~ IM.delete (_clID c)
@@ -184,17 +196,14 @@ updateClouds w = w
 --        & 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
---    | ida == idb = v
+    | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)
---    | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)
+    | otherwise = v
---    | otherwise = v
+  where 
---  where 
+    pa = _clPos a
---    ida = _clID a
+    pb = _clPos b
---    idb = _clID b
+    radDist = (_clRad a + _clRad b) / 2
---    pa = _clPos a
---    pb = _clPos b
---    radDist = (_clRad a + _clRad b) / 2
 
 simpleCrSprings :: World -> World
 simpleCrSprings w = IM.foldr' crSpring w $ _creatures w

src/Dodge/WorldEvent/Cloud.hs

@@ -5,7 +5,7 @@ import Dodge.Data
 import Dodge.Base
 --import Geometry
 import Picture
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 
 import Control.Lens