From 5dbb67349bf7609ad65bc82630d4f0525305387d Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 2 Dec 2025 21:26:28 +0000 Subject: [PATCH] Revert "Simplify clouds" This reverts commit bd50262ca4254d6c44e08835691c697793eb9b51. --- src/Dodge/Cloud.hs | 20 +++++++++++++++++++ src/Dodge/Update.hs | 16 ++++++++------- src/Dodge/Wall/Damage.hs | 4 +++- src/Dodge/Zoning/Base.hs | 1 - src/Dodge/Zoning/Cloud.hs | 42 +++++++++++++++++---------------------- 5 files changed, 50 insertions(+), 33 deletions(-) create mode 100644 src/Dodge/Cloud.hs diff --git a/src/Dodge/Cloud.hs b/src/Dodge/Cloud.hs new file mode 100644 index 000000000..db8615028 --- /dev/null +++ b/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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 295fd5b20..be01bcf3a 100644 --- a/src/Dodge/Update.hs +++ b/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 diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index 5ed6da064..3535364b8 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/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 diff --git a/src/Dodge/Zoning/Base.hs b/src/Dodge/Zoning/Base.hs index 4ea904b01..8ff2769f0 100644 --- a/src/Dodge/Zoning/Base.hs +++ b/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] diff --git a/src/Dodge/Zoning/Cloud.hs b/src/Dodge/Zoning/Cloud.hs index 64e257ea4..22651ff24 100644 --- a/src/Dodge/Zoning/Cloud.hs +++ b/src/Dodge/Zoning/Cloud.hs @@ -1,28 +1,22 @@ -module Dodge.Zoning.Cloud ( - clsNearPoint, - zoneCloud, - zoneDust, - dssNearPoint, -) where +module Dodge.Zoning.Cloud 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 = nearSeg clZoneSize _clZoning --- ---clsNearRect :: Point2 -> Point2 -> World -> [Cloud] ---clsNearRect = nearRect clZoneSize _clZoning --- ---clsNearCirc :: Point2 -> Float -> World -> [Cloud] ---clsNearCirc p r = clsNearRect (p +.+ V2 r r) (p -.- V2 r r) +clsNearSeg :: Point2 -> Point2 -> World -> [Cloud] +clsNearSeg = nearSeg clZoneSize _clZoning + +clsNearRect :: Point2 -> Point2 -> World -> [Cloud] +clsNearRect = nearRect clZoneSize _clZoning + +clsNearCirc :: Point2 -> Float -> World -> [Cloud] +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 = nearSeg dsZoneSize _dsZoning --- ---dssNearRect :: Point2 -> Point2 -> World -> [Dust] ---dssNearRect = nearRect dsZoneSize _dsZoning --- ---dssNearCirc :: Point2 -> Float -> World -> [Dust] ---dssNearCirc p r = dssNearRect (p +.+ V2 r r) (p -.- V2 r r) +dssNearSeg :: Point2 -> Point2 -> World -> [Dust] +dssNearSeg = nearSeg dsZoneSize _dsZoning + +dssNearRect :: Point2 -> Point2 -> World -> [Dust] +dssNearRect = nearRect dsZoneSize _dsZoning + +dssNearCirc :: Point2 -> Float -> World -> [Dust] +dssNearCirc p r = dssNearRect (p +.+ V2 r r) (p -.- V2 r r) dsZoneSize :: Float dsZoneSize = 20