Tweak clouds

src/Dodge/Block.hs

@@ -5,7 +5,6 @@ module Dodge.Block (
 ) where
 
 import Control.Lens
-import Control.Monad
 import Data.Foldable
 import qualified Data.Graph.Inductive as FGL
 import qualified Data.IntSet as IS
@@ -19,13 +18,10 @@ import Dodge.DrWdWd
 import Dodge.LightSource
 import Dodge.Material.Sound
 import Dodge.Wall.Delete
-import Dodge.Wall.Dust
 import Dodge.Wall.Zone
 import Dodge.WorldEvent.Sound
 import Dodge.Zoning.Wall
-import Geometry
 import qualified IntMapHelp as IM
-import RandomHelp
 
 splinterBlock :: Block -> World -> World
 splinterBlock bl w =
@@ -61,12 +57,13 @@ destroyBlock bl w =
         & deleteWallIDs wlids
         & maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted
         & cWorld . lWorld . blocks %~ IM.delete (_blID bl)
-        & flip (foldl' $ flip (wlDustAt awl)) (map (pos +.+) ps)
+--        & muchWlDustAt awl (_blPos bl)
+--        & flip (foldl' $ flip (muchWlDustAt awl)) (map (pos +.+) ps)
   where
     wlids = _blWallIDs bl
-    awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids)
+--    awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids)
-    pos = fst . _wlLine $ awl
+--    pos = fst . _wlLine $ awl
-    ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
+--    ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
 
 -- this does not handle eg doors blocking the path as well
 maybeClearPaths :: Set PathEdgeNodes -> World -> World
@@ -86,15 +83,16 @@ destroyDoor dr w =
         & doDrWdWd (_drDeath dr) dr
         & deleteWallIDs wlids
         & cWorld . lWorld . doors %~ IM.delete (_drID dr)
-        & flip (foldl' (flip $ wlDustAt awl)) (map (pos +.+) ps)
+--        & muchWlDustAt awl (0.5 * uncurry (+) (_drPos dr))
+--        & flip (foldl' (flip $ muchWlDustAt awl)) (map (pos +.+) ps)
         & stopPushing (_drPushes dr)
         & destroyMounts (_drMounts dr)
   where
     wlids = _drWallIDs dr
     --awl = _walls (_cWorld w) IM.! IS.findMin wlids
-    awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids)
+--    awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids)
-    pos = fst . _wlLine $ awl
+--    pos = fst . _wlLine $ awl
-    ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
+--    ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
 
 destroyMounts :: [MountedObject] -> World -> World
 destroyMounts mos w = foldl' (flip destroyMount) w mos

src/Dodge/Material/Damage.hs

@@ -58,9 +58,7 @@ damageMetal 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)
-                . randsound p [clangS,clang1S
+                . randsound p [tingS, ting1S, ting2S, ting3S, ting4S, ting5S]
-                            ,tingS, ting1S, ting2S, ting3S, ting4S, ting5S]
---                . randsound p [tingS, ting1S, ting2S, ting3S, ting4S, ting5S]
         Blunt _ p t ->
             makeSpark NormalSpark (outTo p t) (rdir p t)
                 . randsound p [clangS,clang1S,clang2S]
@@ -119,9 +117,10 @@ damageFlesh dm _ w = w & case dm of
     outTo x t = x -.- squashNormalizeV t
 
 damageDirt :: Damage -> ECW -> World -> World
-damageDirt dm ecw w =
+damageDirt dm _ w =
     w & case dm of
-        Lasering _ p t -> makeSpark FireSpark (outTo p t) (rdir p t)
+        Lasering _ p t -> --  makeSpark FireSpark (outTo p t) (rdir p t)
+            makeCloudAt (Dust Dirt) 200 (addZ 20 (outTo p t))
         Piercing _ p t ->
             makeCloudAt (Dust Dirt) 200 (addZ 20 (outTo p t))
                 . randsound p [slapS, slap1S]
@@ -136,11 +135,6 @@ damageDirt dm ecw w =
         Enterrement{} -> id
         Flashing{} -> id
   where
-    rdir p t = argV $ reflectIn v t
-      where
-        v = case ecw of
-            Right wl -> uncurry (-) $ _wlLine wl
-            Left cr -> vNormal (p - _crPos cr)
     randsound p xs =
         let (x, g) = runState (takeOne xs) $ _randGen w
          in soundStart so p x Nothing . set randGen g

src/Dodge/Wall/Dust.hs

@@ -1,4 +1,4 @@
-module Dodge.Wall.Dust where
+module Dodge.Wall.Dust (muchWlDustAt) where
 
 import Data.Foldable
 import Control.Lens
@@ -7,11 +7,6 @@ import Dodge.WorldEvent.Cloud
 import Geometry
 import RandomHelp
 
-wlDustAt :: Wall -> Point2 -> World -> World
-wlDustAt wl = makeCloudAt (Dust (_wlMaterial wl)) 200 . addZ 20
---  where
---    dustcol = _wlColor wl & _4 .~ 1
-
 muchWlDustAt :: Wall -> Point2 -> World -> World
 muchWlDustAt wl p = flip (foldl' f) [10, 20 .. 100]
   where
@@ -21,4 +16,3 @@ muchWlDustAt wl p = flip (foldl' f) [10, 20 .. 100]
             & randGen .~ g
       where
         (off, g) = runState (randInCirc 1) (_randGen w)
---    dustcol = _wlColor wl & _4 .~ 1

src/Shader/Poke/Cloud.hs

@@ -41,7 +41,7 @@ clColor = \case
     Dust mt -> materialColor mt
 
 materialColor :: Material -> Color
-materialColor = \case
+materialColor = withAlpha 0.5 . \case
     Wood -> dark yellow
     Dirt -> dark $ dark orange
     Stone -> greyN 0.5