Revert "Simplify clouds"

This reverts commit bd50262ca4.

src/Dodge/Cloud.hs

@@ -0,0 +1,20 @@
+module Dodge.Cloud (clAlt) where
+
+import Dodge.Data.Cloud
+
+clAlt :: Cloud -> Float
+clAlt cl = case _clType cl of
+    Smoke -> 90
+    RocketSmoke -> 30
+    CryoReleaseCloud -> 50
+    GasCloud -> 20
+
+--clRad :: Cloud -> Float
+--clRad cl = case _clType cl of
+--    SmokeCloud -> 15
+--    FlamerSmokeCloud -> 6
+--    RocketCloud -> 15
+--    StoneDust -> 15
+--    CryoReleaseCloud -> 10
+--    GasCloud -> 15
+--    BloodCloud -> 10

src/Dodge/Update.hs

@@ -14,7 +14,7 @@ import Data.Maybe
 import Data.Monoid
 import Dodge.Base
 import Dodge.Bullet
---import Dodge.Cloud
+import Dodge.Cloud
 import Dodge.CrGroupUpdate
 import Dodge.Creature.Mass
 import Dodge.Creature.Radius
@@ -802,15 +802,17 @@ updateCloud w c
                 & clTimer -~ 1
         )
   where
-    newVel = 0.95 *^ (springVels & _z +~ 0.02)
+    newVel@(V3 _ _ nvz) = (0.95 *^ springVels) + V3 0 0 (0.01 * vertVel)
+    newVel2 = stripZ newVel
+    vertVel = min 5 $ clAlt c - opz
     springVels = foldl' (clClSpringVel c) (_clVel c) (clsNearPoint oldPos2 w)
-    oldPos = _clPos c
+    oldPos@(V3 _ _ opz) = _clPos c
     oldPos2 = stripZ oldPos
-    newPos@(V3 _ _ npz) = oldPos + newVel
+    newPos@(V3 _ _ npz) = oldPos +.+.+ newVel
     newPos2 = stripZ newPos
     hitWl = bouncePoint (const True) 1 oldPos2 newPos2 w
     finalPos = addZ (max 1 $ min 90 npz) $ maybe newPos2 fst hitWl
-    finalVel = newVel & _xy %~ maybe id (const . snd) hitWl
+    finalVel = addZ nvz $ maybe newVel2 snd hitWl
 
 updateDust :: World -> Dust -> Maybe Dust
 updateDust w c
@@ -833,12 +835,12 @@ updateDust w c
 
 clClSpringVel :: Cloud -> Point3 -> Cloud -> Point3
 clClSpringVel a v b
-    | dist3 pa pb < radDist = v + 0.1 *^ normalize (pa - pb)
+    | dist3 pa pb < radDist = v +.+.+ 0.1 *.*.* normalizeV3 (pa -.-.- pb)
     | otherwise = v
   where
     pa = _clPos a
     pb = _clPos b
-    radDist = 8
+    radDist = 10
 
 --radDist = (_clRad a + _clRad b) / 2
 

src/Dodge/Wall/Damage.hs

@@ -3,7 +3,9 @@
 {- | Controls a walls response to external damage.
  - Indestructible walls may still produce sparks, dust etc
 -}
-module Dodge.Wall.Damage (damageWall) where
+module Dodge.Wall.Damage (
+    damageWall,
+) where
 
 import Control.Monad
 import Data.Foldable

src/Dodge/Zoning/Base.hs

@@ -44,7 +44,6 @@ makeIntInterval x y
 --    [V2 x y | x <- makeIntInterval x1 x2, y <- makeIntInterval y1 y2]
 
 zoneOfPoint :: Float -> Point2 -> Int2
-{-# INLINE zoneOfPoint #-}
 zoneOfPoint = fmap . divTo
 
 zoneOfSeg :: Float -> Point2 -> Point2 -> [Int2]

src/Dodge/Zoning/Cloud.hs

@@ -1,28 +1,22 @@
-module Dodge.Zoning.Cloud (
+module Dodge.Zoning.Cloud where
-    clsNearPoint,
-    zoneCloud,
-    zoneDust,
-    dssNearPoint,
-) where
 
 import Dodge.Data.World
 import Dodge.Zoning.Base
-import Dodge.Zoning.Common
 import Geometry
 import qualified IntMapHelp as IM
+import Dodge.Zoning.Common
 
 clsNearPoint :: Point2 -> World -> [Cloud]
-{-# INLINE clsNearPoint #-}
 clsNearPoint = nearPoint clZoneSize _clZoning
 
---clsNearSeg :: Point2 -> Point2 -> World -> [Cloud]
+clsNearSeg :: Point2 -> Point2 -> World -> [Cloud]
---clsNearSeg = nearSeg clZoneSize _clZoning
+clsNearSeg = nearSeg clZoneSize _clZoning
---
+
---clsNearRect :: Point2 -> Point2 -> World -> [Cloud]
+clsNearRect :: Point2 -> Point2 -> World -> [Cloud]
---clsNearRect = nearRect clZoneSize _clZoning
+clsNearRect = nearRect clZoneSize _clZoning
---
+
---clsNearCirc :: Point2 -> Float -> World -> [Cloud]
+clsNearCirc :: Point2 -> Float -> World -> [Cloud]
---clsNearCirc p r = clsNearRect (p +.+ V2 r r) (p -.- V2 r r)
+clsNearCirc p r = clsNearRect (p +.+ V2 r r) (p -.- V2 r r)
 
 clZoneSize :: Float
 clZoneSize = 20
@@ -36,14 +30,14 @@ zoneCloud cl = zoneMonoid (zoneOfCl cl) [cl]
 dssNearPoint :: Point2 -> World -> [Dust]
 dssNearPoint = nearPoint dsZoneSize _dsZoning
 
---dssNearSeg :: Point2 -> Point2 -> World -> [Dust]
+dssNearSeg :: Point2 -> Point2 -> World -> [Dust]
---dssNearSeg = nearSeg dsZoneSize _dsZoning
+dssNearSeg = nearSeg dsZoneSize _dsZoning
---
+
---dssNearRect :: Point2 -> Point2 -> World -> [Dust]
+dssNearRect :: Point2 -> Point2 -> World -> [Dust]
---dssNearRect = nearRect dsZoneSize _dsZoning
+dssNearRect = nearRect dsZoneSize _dsZoning
---
+
---dssNearCirc :: Point2 -> Float -> World -> [Dust]
+dssNearCirc :: Point2 -> Float -> World -> [Dust]
---dssNearCirc p r = dssNearRect (p +.+ V2 r r) (p -.- V2 r r)
+dssNearCirc p r = dssNearRect (p +.+ V2 r r) (p -.- V2 r r)
 
 dsZoneSize :: Float
 dsZoneSize = 20