Tweak explosions

This commit is contained in:
2024-12-24 14:54:32 +00:00
parent a79dfa1bb3
commit c4b9142d0f
8 changed files with 19 additions and 14 deletions
+1 -1
View File
@@ -19,7 +19,7 @@ updateBarreloid cr = case cr ^?! crType . barrelType of
updateExpBarrel :: Creature -> World -> World updateExpBarrel :: Creature -> World -> World
updateExpBarrel cr w updateExpBarrel cr w
| _crHP cr > 0 = foldl' (flip ($)) (hiss w & cWorld . lWorld . creatures . at (_crID cr) .~ newCr) pierceSparks | _crHP cr > 0 = foldl' (flip ($)) (hiss w & cWorld . lWorld . creatures . at (_crID cr) .~ newCr) pierceSparks
| otherwise = makeExplosionAt (_crPos cr) $ stopSounds w & cWorld . lWorld . creatures . at (_crID cr) .~ Nothing | otherwise = makeExplosionAt (_crPos cr) 0 $ stopSounds w & cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
where where
g = _randGen w g = _randGen w
damages = _csDamage $ _crState cr damages = _csDamage $ _crState cr
+7 -1
View File
@@ -5,6 +5,8 @@ module Dodge.EnergyBall
, makeFlamelet , makeFlamelet
) where ) where
import Dodge.Base.Collide
import Data.Maybe
import Dodge.DamageCircle import Dodge.DamageCircle
import Dodge.Data.World import Dodge.Data.World
import Geometry import Geometry
@@ -47,8 +49,12 @@ updateEnergyBall w eb
| _ebTimer eb <= 0 = (w, Nothing) | _ebTimer eb <= 0 = (w, Nothing)
| otherwise = | otherwise =
( ebFlicker eb $ uncurry (damageCircle 5 (_ebPos eb)) (_ebEff eb) w ( ebFlicker eb $ uncurry (damageCircle 5 (_ebPos eb)) (_ebEff eb) w
, Just $ eb & ebTimer -~ 1 & ebPos .+.+~ _ebVel eb & ebVel .*.*~ 0.9 -- , Just $ eb & ebTimer -~ 1 & ebPos .+.+~ _ebVel eb & ebVel .*.*~ 0.9
, Just $ eb & ebTimer -~ 1 & ebPos .~ bp & ebVel .~ 0.7 * bv
) )
where
p = eb ^. ebPos + eb ^. ebVel
(bp,bv) = fromMaybe (p,eb^.ebVel) $ bouncePoint (const True) 0 (eb ^. ebPos) p w
incBallAt :: Point2 -> World -> World incBallAt :: Point2 -> World -> World
incBallAt p w = incBallAt p w =
+1 -1
View File
@@ -13,7 +13,7 @@ destroyMachine :: Machine -> World -> World
destroyMachine mc = destroyMachine mc =
(cWorld . lWorld . machines %~ IM.delete (_mcID mc)) (cWorld . lWorld . machines %~ IM.delete (_mcID mc))
. deleteWallIDs (_mcWallIDs mc) . deleteWallIDs (_mcWallIDs mc)
. makeExplosionAt (_mcPos mc) . makeExplosionAt (_mcPos mc) 0
. mcKillTerm mc . mcKillTerm mc
. mcKillBut mc . mcKillBut mc
. destroyMcType (mc ^. mcType) mc . destroyMcType (mc ^. mcType) mc
+2 -2
View File
@@ -4,7 +4,7 @@ import Dodge.Data.World
import Dodge.WorldEvent.Explosion import Dodge.WorldEvent.Explosion
import Geometry.Data import Geometry.Data
usePayload :: Payload -> Point2 -> World -> World usePayload :: Payload -> Point2 -> Point2 -> World -> World
usePayload payload = case payload of usePayload payload = case payload of
ExplosionPayload -> makeExplosionAt ExplosionPayload -> makeExplosionAt
DudPayload -> const id DudPayload -> const (const id)
+1 -1
View File
@@ -12,5 +12,5 @@ doPressPlateEvent ppe = case ppe of
ppLevelReset :: PressPlate -> World -> World ppLevelReset :: PressPlate -> World -> World
ppLevelReset pp w ppLevelReset pp w
| dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) w | dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) 0 w
| otherwise = w | otherwise = w
+1 -3
View File
@@ -156,9 +156,7 @@ explodeShell mitid pjid w =
w w
& cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU mitid 30] & cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU mitid 30]
& cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile & cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
-- & itPoint . itUse . heldUse .~ HeldDoNothing & usePayload (_prjPayload thepj) (_prjPos thepj) (_prjVel thepj)
-- & itPoint . itUse . heldMods .~ DoNothingMod
& usePayload (_prjPayload thepj) (_prjPos thepj)
& stopSoundFrom (ShellSound pjid) & stopSoundFrom (ShellSound pjid)
where where
-- itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid-- _itemLocations (_cWorld w) IM.! itid -- itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid-- _itemLocations (_cWorld w) IM.! itid
+1 -1
View File
@@ -22,7 +22,7 @@ selectUse itm _ w = fromMaybe w $ do
& cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile & cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
-- & itPoint . itUse . heldUse .~ HeldDoNothing -- & itPoint . itUse . heldUse .~ HeldDoNothing
-- & itPoint . itUse . heldMods .~ DoNothingMod -- & itPoint . itUse . heldMods .~ DoNothingMod
& usePayload (_prjPayload thepj) (_prjPos thepj) & usePayload (_prjPayload thepj) (_prjPos thepj) (_prjVel thepj)
where where
notdestroyed DestroyPU{} = False notdestroyed DestroyPU{} = False
notdestroyed _ = True notdestroyed _ = True
+5 -4
View File
@@ -70,8 +70,8 @@ makeFlameExplosionAt p w =
-- the ( Nthing :: Maybe Int ) here is "maybe" a creature id that the -- the ( Nthing :: Maybe Int ) here is "maybe" a creature id that the
-- particle passes through for the first frame of its existence -- particle passes through for the first frame of its existence
makeExplosionAt :: Point2 -> World -> World makeExplosionAt :: Point2 -> Point2 -> World -> World
makeExplosionAt p w = makeExplosionAt p vel w =
w w
& soundMultiFrom [Explosion 0, Explosion 1] p bangS Nothing & soundMultiFrom [Explosion 0, Explosion 1] p bangS Nothing
& addFlames & addFlames
@@ -93,8 +93,9 @@ makeExplosionAt p w =
fVs' = zipWith (+.+) fVs $ map inversePushOut fPs' fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
sizes = randomRs (2, 9) $ _randGen w sizes = randomRs (2, 9) $ _randGen w
times = randomRs (15, 20) $ _randGen w times = randomRs (15, 20) $ _randGen w
mF q z v size time = makeFlamelet q z v size time mF q z v size time = makeFlamelet (q - vel) z (v + vel) size time
newFs = zipWith5 mF fPs zs (fmap (3 *.*) fVs') sizes times --newFs = zipWith5 mF fPs zs (fmap (3 *.*) fVs') sizes times
newFs = zipWith4 (mF p) zs (zipWith ((+) . xyV3) fPs'' (fmap (3 *.*) fVs')) sizes times
addFlames w' = foldl' (flip ($)) w' newFs addFlames w' = foldl' (flip ($)) w' newFs
--pushAgainstWalls q = maybe q (uncurry (+.+)) $ reflectPointWalls p q wls --pushAgainstWalls q = maybe q (uncurry (+.+)) $ reflectPointWalls p q wls
--pushAgainstWalls q = maybe q fst $ reflectPointWalls p q wls --pushAgainstWalls q = maybe q fst $ reflectPointWalls p q wls