Separate Clouds and Dust

src/Dodge/Update.hs

@@ -280,6 +280,7 @@ functionalUpdate u =
         . over uvWorld (updateIMl' (_props . _lWorld . _cWorld) updateProp)
         . over uvWorld (updateIMl' (_projectiles . _lWorld . _cWorld) updateProjectile)
         . over uvWorld updateClouds
+        . over uvWorld updateDusts
         . over uvWorld updateGusts
         . over uvWorld (updateIMl' (_terminals . _lWorld . _cWorld) tmUpdate)
         --    . updateIMl _machines mcChooseUpdate
@@ -296,6 +297,7 @@ functionalUpdate u =
         . over uvWorld updateWheelEvents
         --        . over uvWorld (updateMouseInventorySelection (u ^. uvConfig))
         . over uvWorld zoneClouds
+        . over uvWorld zoneDusts
         . over uvWorld zoneCreatures
         -- . over uvWorld updateInventorySelectionList
         . set (uvWorld . cWorld . lWorld . flares) []
@@ -444,6 +446,9 @@ updateLasers w = w' & cWorld . lWorld . flares <>~ concat ls
 zoneClouds :: World -> World
 zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
 
+zoneDusts :: World -> World
+zoneDusts w = w & dsZoning .~ foldl' (flip zoneDust) mempty (w ^. cWorld . lWorld . dusts)
+
 displayTerminalLineString :: TerminalLineString -> World -> (String, Color)
 displayTerminalLineString (TerminalLineConst str col) = const (str, col)
 
@@ -610,6 +615,9 @@ updateSparks = updateObjCatMaybes sparks updateSpark
 updateClouds :: World -> World
 updateClouds = updateObjCatMaybes clouds updateCloud
 
+updateDusts :: World -> World
+updateDusts = updateObjCatMaybes dusts updateDust
+
 --updateBeams :: World -> World
 --updateBeams w =
 --    w
@@ -730,8 +738,6 @@ mvGust _ gu
 cloudEffect :: Cloud -> World -> World
 cloudEffect cl = case _clType cl of
     GasCloud -> cloudPoisonDamage cl
-    RocketCloud -> id
-    CryoReleaseCloud -> id
     _ -> id
 
 updateCloud :: World -> Cloud -> (World, Maybe Cloud)
@@ -755,11 +761,31 @@ updateCloud w c
     newPos@(V3 _ _ npz) = oldPos +.+.+ newVel
     newPos2 = stripZ newPos
     hitWl = bouncePoint (const True) 1 oldPos2 newPos2 w
-    --finalPos = addZ (min 74 npz) $ maybe newPos2 fst hitWl
-    -- allowing clouds at/above height 75 causes graphical glitches 22.05.23
     finalPos = addZ (max 1 $ min 90 npz) $ maybe newPos2 fst hitWl
     finalVel = addZ nvz $ maybe newVel2 snd hitWl
 
+updateDust :: World -> Dust -> (World, Maybe Dust)
+updateDust w c
+    | _dsTimer c < 1 = (w, Nothing)
+    | otherwise =
+        ( w
+        , Just $
+            c
+                & dsPos .~ finalpos
+                & dsVel .~ newvel
+                & dsTimer -~ 1
+        )
+  where
+    springvel = foldl' (dustSpringVel c) (_dsVel c) (dssNearPoint oldPos2 w)
+    v@(V3 _ _ vz) = springvel
+    newvel = 0.9 * (maybe v (addZ vz . snd) hitWl - V3 0 0 0.05)
+    oldPos = _dsPos c
+    oldPos2 = stripZ oldPos
+    newPos@(V3 _ _ npz) = oldPos + v
+    newPos2 = stripZ newPos
+    hitWl = bouncePoint (const True) 1 oldPos2 newPos2 w
+    finalpos = addZ (max 1 $ min 90 npz) $ maybe newPos2 fst hitWl
+
 clClSpringVel :: Cloud -> Point3 -> Cloud -> Point3
 clClSpringVel a v b
     | dist3 pa pb < radDist = v +.+.+ 0.1 *.*.* normalizeV3 (pa -.-.- pb)
@@ -770,6 +796,15 @@ clClSpringVel a v b
     radDist = 10
     --radDist = (_clRad a + _clRad b) / 2
 
+dustSpringVel :: Dust -> Point3 -> Dust -> Point3
+dustSpringVel a v b
+    | dist3 pa pb < radDist = v +.+.+ 0.1 *.*.* normalizeV3 (pa -.-.- pb)
+    | otherwise = v
+  where
+    pa = _dsPos a
+    pb = _dsPos b
+    radDist = 10
+
 simpleCrSprings :: World -> World
 simpleCrSprings w = IM.foldl' (flip crSpring) w $ w ^. cWorld . lWorld . creatures