Refactor basic explosion

2021-03-23 14:50:23 +01:00
parent 885fa4a67e
commit b13467053a
6 changed files with 32 additions and 61 deletions
@@ -483,8 +483,8 @@ newKey m = case IM.lookupMax m of
                        Just (n,_)  -> n+1
                        Nothing     -> 0

-newParticleKey :: World -> Int
-newParticleKey w = case IM.lookupMax (_projectiles w) of
+newProjectileKey :: World -> Int
+newProjectileKey w = case IM.lookupMax (_projectiles w) of
                        Just (n,_)  -> n+1
                        Nothing     -> 0
 newCrKey :: World -> Int
@@ -13,7 +13,7 @@ import qualified Data.IntMap.Strict as IM

 drawCircleAtFor :: Point2 -> Int -> World -> World
 drawCircleAtFor p t w = 
-   let n = newParticleKey w
+   let n = newProjectileKey w
   in  over projectiles ( IM.insert n
            Projectile { _ptPos = p
                     , _ptStartPos = p
@@ -24,7 +24,7 @@ drawCircleAtFor p t w =
                     } ) w
 drawCircleAtForCol :: Point2 -> Int -> Color -> World -> World
 drawCircleAtForCol p t col w = 
-   let n = newParticleKey w
+   let n = newProjectileKey w
   in  over projectiles ( IM.insert n
            Projectile { _ptPos = p
                     , _ptStartPos = p
@@ -35,7 +35,7 @@ drawCircleAtForCol p t col w =
                     } ) w
 drawLineForCol :: [Point2] -> Int -> Color -> World -> World
 drawLineForCol ps t col w = 
-   let n = newParticleKey w
+   let n = newProjectileKey w
   in  over projectiles ( IM.insert n
            Projectile { _ptPos = head ps
                     , _ptStartPos = head ps
@@ -667,7 +667,7 @@ aTeslaArc' cid w =
                $ over projectiles (IM.insert i (makeTeslaArcAt i pos dir)) 
                $ set randGen g w
    where cr  = (_creatures w IM.! cid)
-          i = newParticleKey w
+          i = newProjectileKey w
          pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) 
                          +.+ sideOffset *.* vNormal (unitVectorAtAngle dir)
          (sideOffset,g) = randomR (-5,5) $ _randGen w
@@ -679,7 +679,7 @@ aLaser cid w = over particles' ( (:) (makeLaserAt phaseV pos dir (Just cid)))
                $ flareAt' yellow 0.02 0.05 (pos +.+ 5 *.* unitVectorAtAngle dir)
                w
    where cr  = (_creatures w IM.! cid)
-          i = newParticleKey w
+          i = newProjectileKey w
          pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) 
          dir = _crDir cr
          phaseV = fromMaybe 1 $ cr ^? crInv . ix j . itAttachment . _Just . itPhaseV
@@ -691,7 +691,7 @@ aTractorBeam col cid w
        = set (creatures . ix cid . crInv . ix itRef . wpFire)
                        (shoot $ aTractorBeam ((col + 1) `mod` 10))
                      $ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w
-    where i = newParticleKey w
+    where i = newProjectileKey w
          cr  = (_creatures w IM.! cid)
          pos = _crPos cr +.+ ((_crRad cr +10) *.* unitVectorAtAngle dir)
          dir = _crDir cr
@@ -701,7 +701,7 @@ aRocket :: Int -> World -> World
 aRocket cid w
        = soundOnce (fromIntegral launcherSound)
            $ over projectiles (IM.insert i (makeShellAt i cid pos dir)) w
-    where i = newParticleKey w
+    where i = newProjectileKey w
          cr  = (_creatures w IM.! cid)
          pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
          dir = _crDir cr
@@ -877,7 +877,7 @@ aFlame a cid w
            pos2 = (0.5 *.* vel) +.+ 
                    _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
            w1 = set randGen g w
-            i = newParticleKey w1
+            i = newProjectileKey w1
            -- vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
            vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
            insertFlame = makeFlame pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
@@ -1197,7 +1197,7 @@ withThickSmoke eff cid w = eff cid $ foldr ($) w smokeGen

 makeThinSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World
 makeThinSmokeAt col vel scal time p w = over projectiles (IM.insert n smP) w
-    where n = newParticleKey w
+    where n = newProjectileKey w
          smP = Projectile
                { _ptPos = p
                , _ptStartPos = p
@@ -1400,7 +1400,7 @@ throwGrenade fuseTime n w = setWp $ removePict $ over projectiles addG $ set ran
                              }
          j = _crInvSel $ _creatures w IM.! n
          removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank
-          i = newParticleKey w
+          i = newProjectileKey w
          (a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w)
          (l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g
         -- v = 0.02 * l / _cameraZoom w *.* rotateV (a+_cameraRot w) (limitRange $ _mousePos w)
@@ -1580,7 +1580,7 @@ throwRemoteBomb n w = setLocation $ removePict $ resetFire
                                   , _ptID = i
                                   , _ptUpdate = moveRemoteBomb itid 50 i
                                   }
-          i = newParticleKey w
+          i = newProjectileKey w
          -- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraPos w -.- yourPos)
          d = argV $ _mousePos w
          --(l, _) = randomR (1 - grenadeAccL,1+grenadeAccL) (_randGen w)
@@ -1673,7 +1673,7 @@ moveTeslaArc p d i w =
           f2 0 = cyan
           f2 1 = azure
           f2 _ = white
-           sID  = newParticleKey w
+           sID  = newProjectileKey w
           q1 = last $ init ps'
           q2 = last ps'
           hitWall = collidePointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w
@@ -1863,7 +1863,7 @@ forceFieldFire  cid w = w
 --                                                  (M.insert (_wpAmmoType item) newTotalA) w
 --               | emptyCondition = soundOnce 1 w
 --               | otherwise = w
--    where i = newParticleKey w
+--    where i = newProjectileKey w
 --          cr  = (_creatures w IM.! n)
 --          pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
 --          dir = _crDir cr
@@ -34,7 +34,6 @@ bulHitCr' bt p cr w =
                crKnockBack cid = (/) 1 $ (+) 2 $ _crMass $ _creatures w IM.! cid
                hasArmour cr = any (\it -> it ^? itIdentity == Just FrontArmour) $ _crInv cr
                cid = _crID cr
-                sID     = newParticleKey w
                (d1,g)  = randomR (-0.7,0.7) $ _randGen w
                (colID,_) = randomR (0,11) $ _randGen w
                hitEffect = addDamage 
@@ -208,7 +207,6 @@ hvBulHitWall' bt p x w =  damageBlocks x
            = case wall ^? blHP of 
                Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall)
                _ -> w
-          sID     = newParticleKey w
          cs      = take 10 $ randomRs (0,11) $ _randGen w
          ds      = randomRs (-0.7,0.7) $ _randGen w
          ts      = randomRs (4,8) $ _randGen w
@@ -34,23 +34,13 @@ import qualified Data.IntMap.Strict as IM

 makeExplosionAt :: Point2 -> World -> World
 makeExplosionAt p w = soundOnce grenadeBang 
-                        $ over tempLightSources ((:) $ tLightFade 20 150 intensityF p)
-                        $ fs 
-                        $ over projectiles (IM.insert n exp) 
+                        . addFlames 
+                        . explosionFlashAt p
+                        $ makeShockwaveAt p 50 10 1 white
                            w
-    where n = newParticleKey w
-          exp = Projectile
-                { _ptPos = p
-                , _ptStartPos = p
-                , _ptVel = (0,0)
-                , _ptPict = blank
-                , _ptID = n
-                , _ptUpdate = explosionWaveDamage 6 p n
-                }
-          fVs = fst $ runState ((sequence . take 75 . repeat . randInCirc) 1) $ _randGen w
+    where fVs = fst $ runState ((sequence . take 75 . repeat . randInCirc) 1) $ _randGen w
          fPs' = evalState ((sequence . take 75 . repeat . randInCirc) 15) $ _randGen w
          fPs = map (pushAgainstWalls . (+.+) p . (*.*) 0.5) 
-          --fPs = map (pushAgainstWalls . (+.+) p . (*.*) 5) 
                    fPs'
          inversePushOut v = (15 - magV v) * 0.01 *.* v
          fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
@@ -58,25 +48,9 @@ makeExplosionAt p w = soundOnce grenadeBang
          times = randomRs (20,25) $ _randGen w
          mF q v size time = makeFlameletTimed q v (levLayer GloomLayer - 1) Nothing size time
          newFs = zipWith4 mF fPs (fmap (3 *.*) fVs') sizes times
-          fs w = foldr ($) w newFs
+          addFlames w = foldr ($) w newFs
          pushAgainstWalls q = fromMaybe q $ fmap (\(x,y)-> x +.+ y) 
                                           $ collidePointWalls p q $ wallsNearPoint q w
-          fadeFac x | x > 10 = 0
-                    | otherwise = 1 - fromIntegral x / 10
-          intensityF x | x < 10 = 1 / (10 - fromIntegral x)
-                       | otherwise = 1
-
-explosionWaveDamage :: Int -> Point2 -> Int -> World -> World
-explosionWaveDamage 0 p ptid = over projectiles (IM.delete ptid)
-explosionWaveDamage time p ptid 
-    = set (projectiles . ix ptid . ptUpdate) (explosionWaveDamage (time-1) p ptid)
-      . shockWaveDamage p rad 20
-        . set (projectiles . ix ptid . ptPict) shockwavePic
-        . explosionFlashAt p
-    where shockwavePic = onLayer PtLayer $ uncurry translate p $ color (withAlpha 0.9 white) 
-                                                               $ thickCircle rad (thickness*2)
-          thickness = max 0 $ sqrt $ (fromIntegral time - 2) * 8
-          rad = 40 - thickness

 shockWaveDamage :: Point2 -> Float -> Int -> World -> World
 shockWaveDamage p rad amount w = flip (foldr damageBlocks) hitBlocks $ over creatures (IM.map f) w
@@ -197,7 +171,6 @@ createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
 createSpark time colid pos dir maycid w = over worldEvents 
                                        ((.) $ ( over particles' ((:) spark) 
                                               . flareAt' white 0.02 0.05 pos')
-                                               -- . lowLightAt' pos)
                                        ) w
    where spark = Bul'  { _ptPict' = blank
                        , _ptUpdate' = mvGenBullet'
@@ -239,14 +212,8 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents
            where sp = head (_btTrail' bt)
                  ep = sp +.+ _btVel' bt

-
-        
-
-
 noEff _ _ _ = id

-
-
 makeFlameletTimed :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> Int -> World -> World
 makeFlameletTimed  pos vel levelInt maycid size time w
    = set randGen g $ over particles' ((:) theFlamelet) 
@@ -365,7 +332,7 @@ moveSmoke'' scal time p vel w pt

 makeColorSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World
 makeColorSmokeAt col vel scal time p w = over projectiles (IM.insert n smP) w
-    where n = newParticleKey w
+    where n = newProjectileKey w
          smP = Projectile
                { _ptPos = p
                , _ptStartPos = p
@@ -2,6 +2,7 @@ module Dodge.WorldEvent.Flash
    where
 import Dodge.Data
 import Dodge.Base
+import Dodge.LightSources

 import Dodge.WorldEvent.ThingsHit
 import Dodge.WorldEvent.HelperParticle
@@ -95,7 +96,12 @@ lowLightWidthAt :: Float -> Float -> Color -> Float -> Int -> Float -> Point2 ->
 lowLightWidthAt len wdth col alphay rays rad p w = foldr (lowLightWidthHit len wdth col alphay p) w ps
    where ps = map ((+.+) p) $ nRaysRad rays rad

-explosionFlashAt = lowLightWidthAt 10 5 white 0.3 75 150
+explosionFlashAt :: Point2 -> World -> World
+explosionFlashAt p =  over tempLightSources ((:) $ tLightFade 20 150 intensityFunc p)
+                    . lowLightWidthAt 10 5 white 0.3 75 150 p
+    where intensityFunc x 
+            | x < 10 = 1 / (10 - fromIntegral x)
+            | otherwise = 1

 flameGlareAt = lowLightWidthAt 10 5 orange 0.05 8 50

@@ -105,11 +111,11 @@ lowLightDirected col alpha a b angles w


 muzFlareAt :: Point2 -> World -> World
-muzFlareAt p = over particles' ((:) (muzzleFlareAt p))
-                . lowLightAt p
+muzFlareAt p = over particles' ((:) (muzzleFlarePt p))
+                . lowLightWidthAt 10 5 white 0.5 20 30 p

-muzzleFlareAt :: Point2 -> Particle'
-muzzleFlareAt (x,y) =
+muzzleFlarePt :: Point2 -> Particle'
+muzzleFlarePt (x,y) =
    Particle' 
        { _ptPict' = setDepth 0 
                        . setLayer 1