Working cloud shadows (slow)

src/Dodge/Update.hs

@@ -21,6 +21,7 @@ import Dodge.Initialisation
 import Dodge.Layout
 import Dodge.Floor
 import Geometry
+import Geometry.Vector3D
 
 import Data.List
 import Data.Maybe
@@ -86,7 +87,7 @@ functionalUpdate w = case _menuLayers w of
     zoneClouds = set cloudsZone (foldl' (flip cloudInZone) IM.empty (_clouds w))
     cloudInZone cl = insertInZoneWith x y (++) [cl]
       where 
-        (x,y) = cloudZoneOfPoint $ _clPos cl
+        (x,y) = cloudZoneOfPoint $ stripZ $ _clPos cl
 
 -- | Note the explict use of record syntax. Using lens creates a space leak.
 resetWorldEvents :: World -> World
@@ -171,11 +172,11 @@ checkEndGame w
 updateClouds :: World -> World
 updateClouds w = w' & clouds .~ catMaybes mclouds
   where
-    (w',mclouds) = mapAccumR updateCloud' w (_clouds w)
+    (w',mclouds) = mapAccumR updateCloud w (_clouds w)
 -- did i write a mapMaybeAccumR ?
 
-updateCloud' :: World -> Cloud -> (World,Maybe Cloud)
-updateCloud' w c
+updateCloud :: World -> Cloud -> (World,Maybe Cloud)
+updateCloud w c
     | _clTimer c < 1 = (w, Nothing)
     | otherwise = (_clEffect c c w, Just $ c
         & clPos .~ finalPos
@@ -183,13 +184,17 @@ updateCloud' w c
         & clTimer -~ 1
         )
   where
-    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
+    newVel@(V3 _ _ nvz) = (0.95 *.*.* springVels) +.+.+ (V3 0 0 (0.01 * vertVel))
+    newVel2 = stripZ newVel
+    vertVel = _clAlt c - opz
+    springVels = foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos2 w)
+    oldPos@(V3 _ _ opz) = _clPos c
+    oldPos2 = stripZ oldPos
+    newPos@(V3 _ _ npz) = oldPos +.+.+ newVel
+    newPos2 = stripZ newPos
+    hitWl = collideCircWalls' oldPos2 newPos2 5 $ wallsNearPoint newPos2 w
+    finalPos = addZ npz $ maybe newPos2 fst hitWl
+    finalVel = addZ nvz $ maybe newVel2 snd hitWl
 
 --updateCloud :: World -> Cloud -> Maybe Cloud
 --updateCloud w c
@@ -207,9 +212,9 @@ updateCloud' w c
 --    finalPos = maybe newPos fst hitWl
 --    finalVel = maybe newVel snd hitWl
 
-clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2
+clClSpringVel :: Cloud -> Point3 -> Cloud -> Point3
 clClSpringVel a v b
-    | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)
+    | dist3 pa pb < radDist = v +.+.+ 0.1 *.*.* normalizeV3 (pa -.-.- pb)
     | otherwise = v
   where 
     pa = _clPos a