Allow multiple pulseBalls to be destroyed by one pulse laser shot

This commit is contained in:
2025-07-27 17:21:37 +01:00
parent f1fb0ee768
commit 82678a6afe
2 changed files with 30 additions and 27 deletions
+11 -9
View File
@@ -1,10 +1,10 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Item.Weapon.LaserPath ( module Dodge.Item.Weapon.LaserPath (
reflectLaserAlong, reflectLaserAlong,
reflectPulseLaserAlong, reflectPulseLaserAlong,
) where ) where
import Dodge.Data.Object import Dodge.Data.Object
import Data.Maybe
import Data.Bifunctor import Data.Bifunctor
import Data.Tuple import Data.Tuple
import Dodge.Base.Wall import Dodge.Base.Wall
@@ -65,11 +65,13 @@ refract phasev x y wl p
reflectInternal = 1 < abs (phasev * sin angleInc') reflectInternal = 1 < abs (phasev * sin angleInc')
reflectExternal = 1 < abs (sin angleInc / phasev) reflectExternal = 1 < abs (sin angleInc / phasev)
reflectPulseLaserAlong :: Float -> Point2 -> Point2 -> World -> -- note can hit multiple pulse balls
(Maybe (Point2, Object), [Point2]) reflectPulseLaserAlong :: Float -> Point2 -> Point2 -> World -> ([(Point2,Object)],[Point2])
{-# INLINE reflectPulseLaserAlong #-} {-# INLINE reflectPulseLaserAlong #-}
reflectPulseLaserAlong phasev sp ep w = case listToMaybe . filter (isunshad . snd) $ crWlPbHit sp ep w of reflectPulseLaserAlong phasev sp ep w = f $ filter (isunshad . snd) $ crWlPbHit sp ep w
Just (p, OWall wl) where
f = \case
((p, OWall wl) : _)
| _wlReflect wl -> | _wlReflect wl ->
second (p :) $ second (p :) $
reflectPulseLaserAlong reflectPulseLaserAlong
@@ -84,9 +86,9 @@ reflectPulseLaserAlong phasev sp ep w = case listToMaybe . filter (isunshad . sn
(p +.+ normalizeV (refract phasev sp ep wl p)) (p +.+ normalizeV (refract phasev sp ep wl p))
(refract phasev sp ep wl p) (refract phasev sp ep wl p)
w w
| otherwise -> (Just (p, OWall wl), [p]) | otherwise -> ([(p, OWall wl)], [p])
Just (p, obj) -> (Just (p, obj), [p]) (x@(_,OPulseBall _) : ps ) -> first (x:) $ f ps
Nothing -> (Nothing, [ep]) ((p, obj):_) -> ([(p, obj)], [p])
where [] -> ([], [ep])
isunshad (OWall wl) = _wlUnshadowed wl isunshad (OWall wl) = _wlUnshadowed wl
isunshad _ = True isunshad _ = True
+6 -5
View File
@@ -635,19 +635,20 @@ updatePulseLaser pz = case pz ^. pzTimer of
5 -> (Endo f, [pz & pzTimer -~ 1]) 5 -> (Endo f, [pz & pzTimer -~ 1])
_ -> (Endo g, [pz & pzTimer -~ 1]) _ -> (Endo g, [pz & pzTimer -~ 1])
where where
f w = dodam thHit ps f w = dodam thHit
w w
& cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps) & cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
where where
(thHit, ps) = reflectPulseLaserAlong phasev sp xp w (thHit, ps) = reflectPulseLaserAlong phasev sp xp w
dodam thit ps = case thit of dodam thit = case thit of
Just (p, OCreature cr) -> ((p, OCreature cr):_) ->
cWorld . lWorld . creatures . ix (_crID cr) . crDamage cWorld . lWorld . creatures . ix (_crID cr) . crDamage
.:~ Lasering (pz ^. pzDamage) p (xp - sp) .:~ Lasering (pz ^. pzDamage) p (xp - sp)
Just (p, OWall wl) -> ((p, OWall wl):_) ->
cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty
.:~ Lasering (pz ^. pzDamage) p (xp - sp) .:~ Lasering (pz ^. pzDamage) p (xp - sp)
Just (p, OPulseBall pb) -> ((_, OPulseBall pb):xs) -> dodam xs
.
(cWorld . lWorld . pulseBalls . ix (_pbID pb) . pbTimer .~ 0) (cWorld . lWorld . pulseBalls . ix (_pbID pb) . pbTimer .~ 0)
. makeExplosionAt (_pbPos pb) 0 . makeExplosionAt (_pbPos pb) 0
_ -> id _ -> id