Tweak clouds

src/Dodge/Cloud.hs

@@ -4,14 +4,11 @@ import Dodge.Data.Cloud
 
 clAlt :: Cloud -> Float
 clAlt cl = case _clType cl of
-    SmokeCloud -> 30
-    FlamerSmokeCloud -> 30
+    FlamerSmokeCloud -> 90
     RocketCloud -> 30
-    StoneDust -> 1
-    DirtDust -> 1
+    Dust _ -> 1
     CryoReleaseCloud -> 50
     GasCloud -> 20
-    BloodCloud -> 1
 
 --clRad :: Cloud -> Float
 --clRad cl = case _clType cl of

src/Dodge/Data/Cloud.hs

@@ -5,6 +5,7 @@
 
 module Dodge.Data.Cloud where
 
+import Dodge.Data.Material
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -26,14 +27,12 @@ data Cloud = Cloud
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data CloudType
-    = SmokeCloud
-    | FlamerSmokeCloud
+    = --SmokeCloud
+     FlamerSmokeCloud
     | RocketCloud
     | CryoReleaseCloud
     | GasCloud
-    | StoneDust
-    | DirtDust
-    | BloodCloud
+    | Dust Material
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''Cloud

src/Dodge/Material/Damage.hs

@@ -28,10 +28,10 @@ damageStone dm ecw w =
         Lasering _ p t -> makeSpark FireSpark (outTo p t) (rdir p t)
         Piercing _ p t ->
             makeSpark NormalSpark (outTo p t) (rdir p t)
-                . makeCloudAt StoneDust 200 (addZ 20 (outTo p t))
+                . makeCloudAt (Dust Stone) 200 (addZ 20 (outTo p t))
                 . randsound p [slapS, slap1S]
-        Blunt _ p t -> makeCloudAt StoneDust 200 (addZ 20 (outTo p t))
-        Shattering _ p t -> makeCloudAt StoneDust 200 (addZ 20 (outTo p t))
+        Blunt _ p t -> makeCloudAt (Dust Stone) 200 (addZ 20 (outTo p t))
+        Shattering _ p t -> makeCloudAt (Dust Stone) 200 (addZ 20 (outTo p t))
         Crushing{} -> id
         Explosive{} -> id
         Sparking{} -> id
@@ -100,7 +100,7 @@ damageFlesh dm _ w = w & case dm of
             , bloodShort7S
             , bloodShort8S
             ]
-                . makeCloudAt BloodCloud 50 (addZ 20 (outTo p t))
+                . makeCloudAt (Dust Flesh) 50 (addZ 20 (outTo p t))
     Blunt _ p _ -> randsound p [hitS]
     Shattering _ _ _ -> id
     Crushing{} -> id
@@ -123,10 +123,10 @@ damageDirt dm ecw w =
     w & case dm of
         Lasering _ p t -> makeSpark FireSpark (outTo p t) (rdir p t)
         Piercing _ p t ->
-            makeCloudAt DirtDust 200 (addZ 20 (outTo p t))
+            makeCloudAt (Dust Dirt) 200 (addZ 20 (outTo p t))
                 . randsound p [slapS, slap1S]
-        Blunt _ p t -> makeCloudAt DirtDust 200 (addZ 20 (outTo p t))
-        Shattering _ p t -> makeCloudAt DirtDust 200 (addZ 20 (outTo p t))
+        Blunt _ p t -> makeCloudAt (Dust Dirt) 200 (addZ 20 (outTo p t))
+        Shattering _ p t -> makeCloudAt (Dust Dirt) 200 (addZ 20 (outTo p t))
         Crushing{} -> id
         Explosive{} -> id
         Sparking{} -> id

src/Dodge/Update.hs

@@ -732,7 +732,6 @@ cloudEffect cl = case _clType cl of
     GasCloud -> cloudPoisonDamage cl
     RocketCloud -> id
     CryoReleaseCloud -> id
-    SmokeCloud -> id
     _ -> id
 
 updateCloud :: World -> Cloud -> (World, Maybe Cloud)
@@ -756,8 +755,9 @@ 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
+    --finalPos = addZ (min 74 npz) $ maybe newPos2 fst hitWl
     -- allowing clouds at/above height 75 causes graphical glitches 22.05.23
+    finalPos = addZ (min 90 npz) $ maybe newPos2 fst hitWl
     finalVel = addZ nvz $ maybe newVel2 snd hitWl
 
 clClSpringVel :: Cloud -> Point3 -> Cloud -> Point3

src/Dodge/Wall/Dust.hs

@@ -8,7 +8,7 @@ import Geometry
 import RandomHelp
 
 wlDustAt :: Wall -> Point2 -> World -> World
-wlDustAt _ = makeCloudAt StoneDust 200 . addZ 20
+wlDustAt wl = makeCloudAt (Dust (_wlMaterial wl)) 200 . addZ 20
 --  where
 --    dustcol = _wlColor wl & _4 .~ 1
 
@@ -17,7 +17,7 @@ muchWlDustAt wl p = flip (foldl' f) [10, 20 .. 100]
   where
     f w h =
         w
-            & makeCloudAt StoneDust 200 (addZ h (p +.+ off))
+            & makeCloudAt (Dust (_wlMaterial wl)) 200 (addZ h (p +.+ off))
             & randGen .~ g
       where
         (off, g) = runState (randInCirc 1) (_randGen w)

src/Shader/Poke/Cloud.hs

@@ -2,6 +2,7 @@
 
 module Shader.Poke.Cloud (pokeCloud) where
 
+import Dodge.Data.Material
 import Color
 import Control.Lens
 import qualified Data.Vector.Unboxed as UV
@@ -33,14 +34,23 @@ pokeCloudVerx ptr cl nv i (dx, dy) =
 
 clColor :: CloudType -> Color
 clColor = \case
-    SmokeCloud -> white
     FlamerSmokeCloud -> greyN 0.7
     RocketCloud -> greyN 0.5
-    CryoReleaseCloud -> mixColorsFrac blue cyan 0.5
+    CryoReleaseCloud -> white
     GasCloud -> green
-    StoneDust -> white
-    DirtDust -> dark orange
-    BloodCloud -> red
+    Dust mt -> materialColor mt
+
+materialColor :: Material -> Color
+materialColor = \case
+    Wood -> dark yellow
+    Dirt -> dark $ dark orange
+    Stone -> greyN 0.5
+    Glass -> white
+    Metal -> orange
+    Crystal -> green
+    Flesh -> red
+    Electronics-> greyN 0.2
+
 
 pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
 {-# INLINE pokeCloudFloat #-}