Allow multiple pulseBalls to be destroyed by one pulse laser shot

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

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