Add PlasmaBalls

2026-03-17 10:45:58 +00:00
parent 0ca3bf33c9
commit 902d8e0c00
9 changed files with 245 additions and 172 deletions
@@ -40,8 +40,10 @@ module Dodge.Data.LWorld (
    module Dodge.Data.Wall,
    module Dodge.Data.WorldEffect,
    module Dodge.Data.PulseLaser,
+    module Dodge.Data.PlasmaBall,
 ) where

+import Dodge.Data.PlasmaBall
 import ShapePicture.Data
 import Dodge.Data.PulseLaser
 import Dodge.Data.Equipment.Misc
@@ -101,6 +103,7 @@ data LWorld = LWorld
    , _debris :: [Debris]
    , _projectiles :: IM.IntMap Projectile
    , _bullets :: [Bullet]
+    , _plasmaBalls :: [PlasmaBall]
    , _radarSweeps :: [RadarSweep]
    , _energyBalls :: [EnergyBall]
    , _flames :: [Flame]
@@ -0,0 +1,25 @@
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.PlasmaBall (
+    module Dodge.Data.PlasmaBall
+) where
+
+import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry.Data
+
+data PlasmaBall = PBall
+    { _pbType :: PlasmaBallType
+    , _pbVel :: Point2
+    , _pbPos :: Point2
+    }
+    deriving (Show, Eq, Ord, Read) --Generic, Flat)
+
+data PlasmaBallType = DefaultPlasma
+    deriving (Show, Eq, Ord, Read) --Generic, Flat)
+
+makeLenses ''PlasmaBall
+deriveJSON defaultOptions ''PlasmaBallType
+deriveJSON defaultOptions ''PlasmaBall
@@ -18,10 +18,10 @@ data PulseLaser = PulseLaser
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

 data PulseBall = PulseBall
-    { _pbVel :: Point2
-    , _pbPos :: Point2
-    , _pbTimer :: Int
-    , _pbID :: Int
+    { _pzbVel :: Point2
+    , _pzbPos :: Point2
+    , _pzbTimer :: Int
+    , _pzbID :: Int
    }
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

@@ -120,6 +120,7 @@ defaultLWorld =
        , _debris = mempty
        , _projectiles = IM.empty
        , _bullets = []
+        , _plasmaBalls = []
        , _flames = []
        , _radarSweeps = []
        , _sparks = []
@@ -893,10 +893,10 @@ shootPulseBall (p, q) w =
    w
        & cWorld . lWorld . pulseBalls . at i
            ?~ PulseBall
-                { _pbPos = p ^. _xy
-                , _pbVel = 3.5 * unitVectorAtAngle (Q.qToAng q)
-                , _pbTimer = 200
-                , _pbID = i
+                { _pzbPos = p ^. _xy
+                , _pzbVel = 3.5 * unitVectorAtAngle (Q.qToAng q)
+                , _pzbTimer = 200
+                , _pzbID = i
                }
        & soundStart (PBSound i) (p ^. _xy) energyReleaseS Nothing
  where
@@ -25,7 +25,8 @@ worldSPic cfig u =
        <> foldup propSPic (filtOn _prPos _props)
        <> foldMap' debrisSPic (filtOn' (xyV3 . _dbPos) _debris)
        <> foldup drawProjectile (filtOn (^. pjPos . _xy) _projectiles)
-        <> foldup drawPulseBall (filtOn _pbPos _pulseBalls)
+        <> foldup drawPulseBall (filtOn _pzbPos _pulseBalls)
+        <> foldMap' drawPlasmaBall (filtOn' _pbPos _plasmaBalls)
        <> foldup (shiftDraw _blPos _blDir (const drawBlock)) (filtOn _blPos _blocks)
        <> foldMap' (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _foreShapes)
        <> foldup (drawCreature (lw ^. items)) (filtOn (^. crPos . _xy) _creatures)
@@ -94,11 +95,19 @@ drawCliff x y =
 drawPulseBall :: PulseBall -> SPic
 drawPulseBall pb =
    translateSPz 20
-        . uncurryV translateSPxy (pb ^. pbPos)
+        . uncurryV translateSPxy (pb ^. pzbPos)
        . noShape
        . setLayer BloomLayer
        $ circleSolidCol green white 10

+drawPlasmaBall :: PlasmaBall -> SPic
+drawPlasmaBall pb =
+    translateSPz 20
+        . uncurryV translateSPxy (pb ^. pbPos)
+        . noShape
+        . setLayer BloomLayer
+        $ circleSolidCol green white 5
+
 drawCreature :: IM.IntMap Item -> Creature -> SPic
 drawCreature m cr = translateSP (_crPos cr) . rotateSP (_crDir cr) $
    case cr ^. crType of
@@ -277,6 +277,7 @@ functionalUpdate =
        . over uvWorld updateFlames
        . over uvWorld updateShockwaves
        . over uvWorld updateBullets
+        . over uvWorld updatePlasmaBalls
        . over uvWorld updateDebris
        . over uvWorld updateEnergyBalls -- energybs can be created by bullets,
        -- so should probably be updated before bullets
@@ -481,17 +482,13 @@ updatePulseLasers w = f w & cWorld . lWorld . pulseLasers .~ pzs
  where
    (Endo f, pzs) = foldMap updatePulseLaser (w ^. cWorld . lWorld . pulseLasers)

-updatePulseBall :: PulseBall -> World -> World
-updatePulseBall pb w
-    | Just (_, ecrwl) <- thit =
-        w & cWorld . lWorld . pulseBalls . at (pb ^. pbID) .~ Nothing
-            & cWorld . lWorld %~ dodam ecrwl
-    | pb ^. pbTimer <= 0 =
-        w & cWorld . lWorld . pulseBalls . at (pb ^. pbID) .~ Nothing
-    | otherwise =
-        w & cWorld . lWorld . pulseBalls . ix (pb ^. pbID) . pbTimer -~ 1
-            & cWorld . lWorld . pulseBalls . ix (pb ^. pbID) . pbPos .~ ep
-            & pbFlicker pb
+updatePlasmaBall :: World -> PlasmaBall -> (World, Maybe PlasmaBall)
+updatePlasmaBall w pb
+    | Just (_, ecrwl) <- thit = ( w 
+            & cWorld . lWorld %~ dodam ecrwl, Nothing)
+    | norm (pb ^. pbVel) <= 0 = (w, Nothing)
+    | otherwise = ( w  -- flicker?
+        , Just $ pb & pbPos .~ ep )
  where
    dodam = \case
        Left cr -> creatures . ix (_crID cr) . crDamage .:~ thedam
@@ -501,12 +498,32 @@ updatePulseBall pb w
    ep = sp + pb ^. pbVel
    thit = thingHit sp ep w

+updatePulseBall :: PulseBall -> World -> World
+updatePulseBall pb w
+    | Just (_, ecrwl) <- thit =
+        w & cWorld . lWorld . pulseBalls . at (pb ^. pzbID) .~ Nothing
+            & cWorld . lWorld %~ dodam ecrwl
+    | pb ^. pzbTimer <= 0 =
+        w & cWorld . lWorld . pulseBalls . at (pb ^. pzbID) .~ Nothing
+    | otherwise =
+        w & cWorld . lWorld . pulseBalls . ix (pb ^. pzbID) . pzbTimer -~ 1
+            & cWorld . lWorld . pulseBalls . ix (pb ^. pzbID) . pzbPos .~ ep
+            & pbFlicker pb
+  where
+    dodam = \case
+        Left cr -> creatures . ix (_crID cr) . crDamage .:~ thedam
+        Right wl -> wallDamages . at (_wlID wl) . non mempty .:~ thedam
+    thedam = Lasering 100 ep (pb ^. pzbVel)
+    sp = pb ^. pzbPos
+    ep = sp + pb ^. pzbVel
+    thit = thingHit sp ep w
+
 pbFlicker :: PulseBall -> World -> World
 pbFlicker pt =
    cWorld . lWorld . lights
-        .:~ LSParam (addZ 5 $ _pbPos pt) d (0.5 * xyzV4 chartreuse)
+        .:~ LSParam (addZ 5 $ _pzbPos pt) d (0.5 * xyzV4 chartreuse)
  where
-    d = 4 * fromIntegral (10 + abs ((_pbTimer pt `mod` 20) - 10))
+    d = 4 * fromIntegral (10 + abs ((_pzbTimer pt `mod` 20) - 10))

 zoneClouds :: World -> World
 zoneClouds w =
@@ -605,6 +622,13 @@ updateBullets w = w' & cWorld . lWorld . bullets <>~ catMaybes ps
        mapAccumR updateBullet (w & cWorld . lWorld . bullets .~ []) $
            w ^. cWorld . lWorld . bullets

+updatePlasmaBalls :: World -> World
+updatePlasmaBalls w = w' & cWorld . lWorld . plasmaBalls <>~ catMaybes ps
+  where
+    (w', ps) =
+        mapAccumR updatePlasmaBall (w & cWorld . lWorld . plasmaBalls .~ []) $
+            w ^. cWorld . lWorld . plasmaBalls
+
 updateDebris :: World -> World
 updateDebris w = w' & cWorld . lWorld . debris <>~ catMaybes xs
  where
@@ -665,8 +689,8 @@ updatePulseLaser pz = case pz ^. pzTimer of
                .:~ Lasering (pz ^. pzDamage) p (xp - sp)
        ((_, OPulseBall pb) : xs) ->
            dodam xs
-                . (cWorld . lWorld . pulseBalls . ix (_pbID pb) . pbTimer .~ 0)
-                . makeExplosionAt (_pbPos pb `v2z` 20) 0
+                . (cWorld . lWorld . pulseBalls . ix (_pzbID pb) . pzbTimer .~ 0)
+                . makeExplosionAt (_pzbPos pb `v2z` 20) 0
        _ -> id
    phasev = _pzPhaseV pz
    sp = _pzPos pz
@@ -99,7 +99,7 @@ pbsHit sp ep w
    | sp == ep = mempty
    | otherwise =
        sortOn (dist sp . fst)
-            . mapMaybe (\pb -> (,pb) <$> fst (intersectCircSeg (_pbPos pb) 8 sp ep))
+            . mapMaybe (\pb -> (,pb) <$> fst (intersectCircSeg (_pzbPos pb) 8 sp ep))
            . IM.elems
            $ w ^. cWorld . lWorld . pulseBalls