Split gasses and clouds

2025-12-02 21:47:17 +00:00
parent 984a114310
commit b2cb8cfe11
11 changed files with 262 additions and 192 deletions
@@ -7,7 +7,6 @@ clAlt cl = case _clType cl of
    Smoke -> 90
    RocketSmoke -> 30
    CryoReleaseCloud -> 50
-    GasCloud -> 20

 --clRad :: Cloud -> Float
 --clRad cl = case _clType cl of
@@ -21,7 +21,6 @@ data CloudType
    = Smoke
    | RocketSmoke
    | CryoReleaseCloud
-    | GasCloud
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

 data Dust = Dust
@@ -32,8 +31,22 @@ data Dust = Dust
    }
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

+data Gas = Gas
+    { _gsPos :: Point3
+    , _gsVel :: Point3
+    , _gsTimer :: Int
+    , _gsType :: GasType
+    }
+    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+data GasType = PoisonGas
+    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
 makeLenses ''Cloud
 deriveJSON defaultOptions ''CloudType
 deriveJSON defaultOptions ''Cloud
 makeLenses ''Dust
 deriveJSON defaultOptions ''Dust
+makeLenses ''Gas
+deriveJSON defaultOptions ''GasType
+deriveJSON defaultOptions ''Gas
@@ -95,6 +95,7 @@ data LWorld = LWorld
    , _items :: IM.IntMap Item
    , _clouds :: [Cloud]
    , _dusts :: [Dust]
+    , _gasses :: [Gas]
    , _gusts :: IM.IntMap Gust
    , _props :: IM.IntMap Prop
    , _debris :: [Debris]
@@ -45,6 +45,7 @@ data World = World
    , _worldEventFlags :: Set WorldEventFlag
    , _crZoning :: IntMap (IntMap IntSet)
    , _clZoning :: IntMap (IntMap [Cloud])
+    , _gasZoning :: IntMap (IntMap [Gas])
    , _dsZoning :: IntMap (IntMap [Dust])
    , _wlZoning :: IntMap (IntMap IntSet) -- Zoning IM.IntMap Wall
 --    , _pnZoning :: IntMap (IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
@@ -45,6 +45,7 @@ defaultWorld =
        , _worldEventFlags = mempty
        , _crZoning = mempty
        , _clZoning = mempty
+        , _gasZoning = mempty
        , _dsZoning = mempty
        , _wlZoning = mempty
 --        , _pnZoning = mempty
@@ -106,6 +107,7 @@ defaultLWorld =
        , _creatures = IM.empty
        , _creatureGroups = IM.empty
        , _clouds = mempty
+        , _gasses = mempty
        , _dusts = mempty
        , _gusts = IM.empty
 --        , _itemLocations = IM.empty
@@ -276,6 +276,7 @@ functionalUpdate =
            (updateIMl' (_linearShockwaves . _lWorld . _cWorld) updateLinearShockwave)
        . over uvWorld (updateIMl' (_projectiles . _lWorld . _cWorld) updateProjectile)
        . over uvWorld updateClouds
+        . over uvWorld updateGasses
        . over uvWorld updateDusts
        . over uvWorld updateGusts
        . over uvWorld (updateIMl' (_terminals . _lWorld . _cWorld) tmUpdate)
@@ -471,6 +472,7 @@ pbFlicker pt =
 zoneClouds :: World -> World
 zoneClouds w =
    w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
+     & gasZoning .~ foldl' (flip zoneGas) mempty (w ^. cWorld . lWorld . gasses)

 zoneDusts :: World -> World
 zoneDusts w = w & dsZoning .~ foldl' (flip zoneDust) mempty (w ^. cWorld . lWorld . dusts)
@@ -664,6 +666,9 @@ updateSparks = updateObjCatMaybes sparks updateSpark
 updateClouds :: World -> World
 updateClouds = updateObjCatMaybes clouds updateCloud

+updateGasses :: World -> World
+updateGasses = updateObjCatMaybes gasses updateGas
+
 updateDusts :: World -> World
 updateDusts w = updateObjMapMaybe dusts (updateDust w) w

@@ -785,16 +790,15 @@ mvGust _ gu
                & guPos .+.+~ _guVel gu
                & guTime -~ 1

-cloudEffect :: Cloud -> World -> World
-cloudEffect cl = case _clType cl of
-    GasCloud -> cloudPoisonDamage cl
-    _ -> id
+gasEffect :: Gas -> World -> World
+gasEffect cl = case _gsType cl of
+    PoisonGas -> cloudPoisonDamage cl

 updateCloud :: World -> Cloud -> (World, Maybe Cloud)
 updateCloud w c
    | _clTimer c < 1 = (w, Nothing)
    | otherwise =
-        ( cloudEffect c w
+        ( w
        , Just $
            c
                & clPos .~ finalPos
@@ -814,6 +818,30 @@ updateCloud w c
    finalPos = addZ (min 90 npz) $ maybe newPos2 fst hitWl
    finalVel = addZ nvz $ maybe newVel2 snd hitWl

+updateGas :: World -> Gas -> (World, Maybe Gas)
+updateGas w c
+    | _gsTimer c < 1 = (w, Nothing)
+    | otherwise =
+        ( gasEffect c w
+        , Just $
+            c
+                & gsPos .~ finalPos
+                & gsVel .~ finalVel
+                & gsTimer -~ 1
+        )
+  where
+    newVel@(V3 _ _ nvz) = (0.95 *^ springVels) + V3 0 0 (0.01 * vertVel)
+    newVel2 = stripZ newVel
+    vertVel = min 5 $ 20 - opz
+    springVels = foldl' (gasGasSpringVel c) (_gsVel c) (gassesNearPoint oldPos2 w)
+    oldPos@(V3 _ _ opz) = _gsPos c
+    oldPos2 = stripZ oldPos
+    newPos@(V3 _ _ npz) = oldPos + newVel
+    newPos2 = stripZ newPos
+    hitWl = bouncePoint (const True) 1 oldPos2 newPos2 w
+    finalPos = addZ (min 90 npz) $ maybe newPos2 fst hitWl
+    finalVel = addZ nvz $ maybe newVel2 snd hitWl
+
 updateDust :: World -> Dust -> Maybe Dust
 updateDust w c
    | _dsTimer c < 1 = Nothing
@@ -842,6 +870,15 @@ clClSpringVel a v b
    pb = _clPos b
    radDist = 10

+gasGasSpringVel :: Gas -> Point3 -> Gas -> Point3
+gasGasSpringVel a v b
+    | dist3 pa pb < radDist = v + 0.1 *^ normalizeV3 (pa - pb)
+    | otherwise = v
+  where
+    pa = _gsPos a
+    pb = _gsPos b
+    radDist = 10
+
 --radDist = (_clRad a + _clRad b) / 2

 dustSpringVel :: Dust -> Point3 -> Dust -> Point3
@@ -8,10 +8,10 @@ import Geometry.Vector3D
 import LensHelp
 import Linear

-cloudPoisonDamage :: Cloud -> World -> World
+cloudPoisonDamage :: Gas -> World -> World
 cloudPoisonDamage c w = foldl' (flip doDam) w (filter f $ crsNearPoint clpos w)
  where
    doDam cr =
        cWorld . lWorld . creatures . ix (_crID cr) . crDamage .:~ Poison 1
-    f cr = dist3 (_crPos cr & _z +~ 20) (_clPos c) < crRad (cr ^. crType) + 20
-    clpos = stripZ $ _clPos c
+    f cr = dist3 (_crPos cr & _z +~ 20) (_gsPos c) < crRad (cr ^. crType) + 20
+    clpos = stripZ $ _gsPos c
@@ -15,14 +15,11 @@ makeGasCloud ::
    Point2 ->
    World ->
    World
-makeGasCloud pos vel = cWorld . lWorld . clouds .:~ theCloud
-  where
-    theCloud =
-        Cloud
-            { _clPos = addZ 20 pos
-            , _clVel = addZ 0 vel
-            , _clTimer = 400
-            , _clType = GasCloud
+makeGasCloud pos vel = cWorld . lWorld . gasses .:~ Gas
+            { _gsPos = addZ 20 pos
+            , _gsVel = addZ 0 vel
+            , _gsTimer = 400
+            , _gsType = PoisonGas
            }

 {- Attach poison cloud damage to creatures near cloud.  -}
@@ -9,6 +9,9 @@ import Dodge.Zoning.Common
 clsNearPoint :: Point2 -> World -> [Cloud]
 clsNearPoint = nearPoint clZoneSize _clZoning

+gassesNearPoint :: Point2 -> World -> [Gas]
+gassesNearPoint = nearPoint clZoneSize _gasZoning
+
 clsNearSeg :: Point2 -> Point2 -> World -> [Cloud]
 clsNearSeg = nearSeg clZoneSize _clZoning

@@ -24,9 +27,15 @@ clZoneSize = 20
 zoneOfCl :: Cloud -> Int2
 zoneOfCl = zoneOfPoint clZoneSize . xyV3 . _clPos

+zoneOfGas :: Gas -> Int2
+zoneOfGas = zoneOfPoint clZoneSize . xyV3 . _gsPos
+
 zoneCloud :: Cloud -> IM.IntMap (IM.IntMap [Cloud]) -> IM.IntMap (IM.IntMap [Cloud])
 zoneCloud cl = zoneMonoid (zoneOfCl cl) [cl]

+zoneGas :: Gas -> IM.IntMap (IM.IntMap [Gas]) -> IM.IntMap (IM.IntMap [Gas])
+zoneGas cl = zoneMonoid (zoneOfGas cl) [cl]
+
 dssNearPoint :: Point2 -> World -> [Dust]
 dssNearPoint = nearPoint dsZoneSize _dsZoning