Simplify clouds

src/Dodge/Cloud.hs

@@ -1,20 +0,0 @@
-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,17 +802,15 @@ updateCloud w c
                 & clTimer -~ 1
         )
   where
-    newVel@(V3 _ _ nvz) = (0.95 *^ springVels) + V3 0 0 (0.01 * vertVel)
+    newVel = 0.95 *^ (springVels & _z +~ 0.02)
-    newVel2 = stripZ newVel
-    vertVel = min 5 $ clAlt c - opz
     springVels = foldl' (clClSpringVel c) (_clVel c) (clsNearPoint oldPos2 w)
-    oldPos@(V3 _ _ opz) = _clPos c
+    oldPos = _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 = addZ nvz $ maybe newVel2 snd hitWl
+    finalVel = newVel & _xy %~ maybe id (const . snd) hitWl
 
 updateDust :: World -> Dust -> Maybe Dust
 updateDust w c
@@ -835,12 +833,12 @@ updateDust w c
 
 clClSpringVel :: Cloud -> Point3 -> Cloud -> Point3
 clClSpringVel a v b
-    | dist3 pa pb < radDist = v +.+.+ 0.1 *.*.* normalizeV3 (pa -.-.- pb)
+    | dist3 pa pb < radDist = v + 0.1 *^ normalize (pa - pb)
     | otherwise = v
   where
     pa = _clPos a
     pb = _clPos b
-    radDist = 10
+    radDist = 8
 
 --radDist = (_clRad a + _clRad b) / 2
 

src/Dodge/Wall/Damage.hs

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

src/Dodge/Zoning/Base.hs

@@ -44,6 +44,7 @@ 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,22 +1,28 @@
-module Dodge.Zoning.Cloud where
+module Dodge.Zoning.Cloud (
+    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
@@ -30,14 +36,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