From 82678a6afe6b96e82925e58a28317d43310a21aa Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 27 Jul 2025 17:21:37 +0100 Subject: [PATCH] Allow multiple pulseBalls to be destroyed by one pulse laser shot --- src/Dodge/Item/Weapon/LaserPath.hs | 46 ++++++++++++++++-------------- src/Dodge/Update.hs | 11 +++---- 2 files changed, 30 insertions(+), 27 deletions(-) diff --git a/src/Dodge/Item/Weapon/LaserPath.hs b/src/Dodge/Item/Weapon/LaserPath.hs index c2d8955e7..b86681bb9 100644 --- a/src/Dodge/Item/Weapon/LaserPath.hs +++ b/src/Dodge/Item/Weapon/LaserPath.hs @@ -1,10 +1,10 @@ +{-# LANGUAGE LambdaCase #-} module Dodge.Item.Weapon.LaserPath ( reflectLaserAlong, reflectPulseLaserAlong, ) where import Dodge.Data.Object -import Data.Maybe import Data.Bifunctor import Data.Tuple import Dodge.Base.Wall @@ -65,28 +65,30 @@ refract phasev x y wl p reflectInternal = 1 < abs (phasev * sin angleInc') reflectExternal = 1 < abs (sin angleInc / phasev) -reflectPulseLaserAlong :: Float -> Point2 -> Point2 -> World -> - (Maybe (Point2, Object), [Point2]) +-- note can hit multiple pulse balls +reflectPulseLaserAlong :: Float -> Point2 -> Point2 -> World -> ([(Point2,Object)],[Point2]) {-# INLINE reflectPulseLaserAlong #-} -reflectPulseLaserAlong phasev sp ep w = case listToMaybe . filter (isunshad . snd) $ crWlPbHit sp ep w of - Just (p, OWall wl) - | _wlReflect wl -> - second (p :) $ - reflectPulseLaserAlong - phasev - (p +.+ unitVectorAtAngle (reflDirWall sp p wl)) - (p +.+ dist p ep *.* unitVectorAtAngle (reflDirWall sp p wl)) - w - | wlIsSeeThrough wl -> - second (p :) $ - reflectPulseLaserAlong - phasev - (p +.+ normalizeV (refract phasev sp ep wl p)) - (refract phasev sp ep wl p) - w - | otherwise -> (Just (p, OWall wl), [p]) - Just (p, obj) -> (Just (p, obj), [p]) - Nothing -> (Nothing, [ep]) +reflectPulseLaserAlong phasev sp ep w = f $ filter (isunshad . snd) $ crWlPbHit sp ep w where + f = \case + ((p, OWall wl) : _) + | _wlReflect wl -> + second (p :) $ + reflectPulseLaserAlong + phasev + (p +.+ unitVectorAtAngle (reflDirWall sp p wl)) + (p +.+ dist p ep *.* unitVectorAtAngle (reflDirWall sp p wl)) + w + | wlIsSeeThrough wl -> + second (p :) $ + reflectPulseLaserAlong + phasev + (p +.+ normalizeV (refract phasev sp ep wl p)) + (refract phasev sp ep wl p) + w + | otherwise -> ([(p, OWall wl)], [p]) + (x@(_,OPulseBall _) : ps ) -> first (x:) $ f ps + ((p, obj):_) -> ([(p, obj)], [p]) + [] -> ([], [ep]) isunshad (OWall wl) = _wlUnshadowed wl isunshad _ = True diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 5c6640ffd..9af2a8b9d 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -635,19 +635,20 @@ updatePulseLaser pz = case pz ^. pzTimer of 5 -> (Endo f, [pz & pzTimer -~ 1]) _ -> (Endo g, [pz & pzTimer -~ 1]) where - f w = dodam thHit ps + f w = dodam thHit w & cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps) where (thHit, ps) = reflectPulseLaserAlong phasev sp xp w - dodam thit ps = case thit of - Just (p, OCreature cr) -> + dodam thit = case thit of + ((p, OCreature cr):_) -> cWorld . lWorld . creatures . ix (_crID cr) . crDamage .:~ Lasering (pz ^. pzDamage) p (xp - sp) - Just (p, OWall wl) -> + ((p, OWall wl):_) -> cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty .:~ Lasering (pz ^. pzDamage) p (xp - sp) - Just (p, OPulseBall pb) -> + ((_, OPulseBall pb):xs) -> dodam xs + . (cWorld . lWorld . pulseBalls . ix (_pbID pb) . pbTimer .~ 0) . makeExplosionAt (_pbPos pb) 0 _ -> id