From 35a3f005c4e5e1790875babe4b35c5bdea0ee6e3 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 24 Jun 2025 16:40:00 +0100 Subject: [PATCH] Tweak clouds --- src/Dodge/Block.hs | 22 ++++++++++------------ src/Dodge/Material/Damage.hs | 14 ++++---------- src/Dodge/Wall/Dust.hs | 8 +------- src/Shader/Poke/Cloud.hs | 2 +- 4 files changed, 16 insertions(+), 30 deletions(-) diff --git a/src/Dodge/Block.hs b/src/Dodge/Block.hs index be646dcb7..1c21ed058 100644 --- a/src/Dodge/Block.hs +++ b/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) - pos = fst . _wlLine $ awl - ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w +-- awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids) +-- pos = fst . _wlLine $ awl +-- 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) - pos = fst . _wlLine $ awl - ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w +-- awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids) +-- pos = fst . _wlLine $ awl +-- ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w destroyMounts :: [MountedObject] -> World -> World destroyMounts mos w = foldl' (flip destroyMount) w mos diff --git a/src/Dodge/Material/Damage.hs b/src/Dodge/Material/Damage.hs index cf1c1fdaf..03e9ce752 100644 --- a/src/Dodge/Material/Damage.hs +++ b/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 - ,tingS, ting1S, ting2S, ting3S, ting4S, ting5S] --- . randsound p [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 diff --git a/src/Dodge/Wall/Dust.hs b/src/Dodge/Wall/Dust.hs index ebe778cc7..09c9cd75f 100644 --- a/src/Dodge/Wall/Dust.hs +++ b/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 diff --git a/src/Shader/Poke/Cloud.hs b/src/Shader/Poke/Cloud.hs index 7ea24e651..d7882eba2 100644 --- a/src/Shader/Poke/Cloud.hs +++ b/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