Fix shockwave damage radius for walls

src/Dodge/WorldEvent/Explosion.hs

@@ -11,7 +11,7 @@ module Dodge.WorldEvent.Explosion (
 import Control.Monad
 import Data.List
 import Dodge.Data.World
-import Dodge.EnergyBall
+--import Dodge.EnergyBall
 import Dodge.SoundLogic
 import Dodge.WorldEvent.Shockwave
 import Dodge.WorldEvent.SpawnParticle
@@ -20,7 +20,7 @@ import LensHelp
 import Picture
 import RandomHelp
 import Linear.V3
-import Linear.Metric
+--import Linear.Metric
 
 makePoisonExplosionAt ::
     -- | Position
@@ -71,23 +71,25 @@ makeFlameExplosionAt p w =
 -- particle passes through for the first frame of its existence
 
 makeExplosionAt :: Point3 -> Point3 -> World -> World
-makeExplosionAt p vel w =
+--makeExplosionAt p vel w =
+makeExplosionAt p _ w =
     w
         & soundStart (Explosion (w ^. cWorld . lWorld . lClock)) (p ^. _xy) bangS Nothing
-        & addFlames
+--        & addFlames
         & cWorld . lWorld . worldEvents 
             .:~ MakeTempLight (LSParam p 150 (V3 1 0.5 0)) 20
-        & makeShockwaveAt [] p 50 50 1 white
+--        & makeShockwaveAt [] p 50 50 1 white
+        & makeShockwaveAt [] p 50 5000 1 white
   where
-    fVs = fmap (`v2z` 0) $ replicateM 100 (randInCirc 1) & evalState $ _randGen w
-    fPs' = fmap (`v2z` 0) $ replicateM 100 (randInCirc 5) & evalState $ _randGen w
-    fdamps = replicateM 100 (state $ randomR (0,1)) & evalState $ _randGen w
-    inversePushOut v = (15 - norm v) * 0.01 *.*.* v
-    fVs' = zipWith (+.+.+) fVs $ map inversePushOut fPs'
-    sizes = randomRs (2, 9) $ _randGen w
-    times = randomRs (15, 20) $ _randGen w
-    mF q v damp size time = makeFlamelet 
-        --(q - (2*v + 2* vel)) (v + damp *.*.* vel) size time
-        (q - (2*v )) (v + damp *.*.* vel) size time
-    newFs = zipWith4 (mF p) (zipWith (+) fPs' (fmap (3 *.*.*) fVs')) fdamps sizes times
-    addFlames w' = foldl' (flip ($)) w' newFs
+--    fVs = fmap (`v2z` 0) $ replicateM 100 (randInCirc 1) & evalState $ _randGen w
+--    fPs' = fmap (`v2z` 0) $ replicateM 100 (randInCirc 5) & evalState $ _randGen w
+--    fdamps = replicateM 100 (state $ randomR (0,1)) & evalState $ _randGen w
+--    inversePushOut v = (15 - norm v) * 0.01 *.*.* v
+--    fVs' = zipWith (+.+.+) fVs $ map inversePushOut fPs'
+--    sizes = randomRs (2, 9) $ _randGen w
+--    times = randomRs (15, 20) $ _randGen w
+--    mF q v damp size time = makeFlamelet 
+--        --(q - (2*v + 2* vel)) (v + damp *.*.* vel) size time
+--        (q - (2*v )) (v + damp *.*.* vel) size time
+--    newFs = zipWith4 (mF p) (zipWith (+) fPs' (fmap (3 *.*.*) fVs')) fdamps sizes times
+--    addFlames w' = foldl' (flip ($)) w' newFs

src/Dodge/WorldEvent/Shockwave.hs

@@ -8,7 +8,6 @@ import Geometry
 import LensHelp
 import Picture
 
--- currently very effective against walls
 makeShockwaveAt ::
     -- | IDs of invulnerable creatures.
     [Int] ->

src/Dodge/WorldEvent/ThingsHit.hs

@@ -17,6 +17,7 @@ module Dodge.WorldEvent.ThingsHit (
     isWalkable,
 ) where
 
+import Control.Applicative
 import Dodge.Wall.Pathing
 import Data.Monoid
 import qualified Data.Set as S
@@ -146,9 +147,17 @@ wlsHitUnsorted sp ep
 wlsHitRadial :: Point2 -> Float -> World -> [(Point2, Wall)]
 wlsHitRadial p r = mapMaybe f . wlsNearCirc p r
   where
-    f wl = uncurry (intersectSegSeg p (p - r *.* v)) (_wlLine wl) <&> (,wl)
+    --f wl = uncurry (intersectSegSeg p (p - r *.* v)) (_wlLine wl) <&> (,wl)
+    f wl = mhp <&> (,wl)
       where
-        v = normalizeV . vNormal . uncurry (-) $ _wlLine wl
+        (x,y) = wl ^. wlLine
+        t mp = do
+            p' <- mp
+            guard (distance p p' < r) 
+            mp
+        orthp = t $ orthogonalPointOnSeg x y p
+        mhp = orthp <|> t (return x) <|> t (return y)
+--        v = normalizeV . vNormal . uncurry (-) $ _wlLine wl
 
 crsHitRadial :: Point2 -> Float -> World -> [(Point2, Creature)]
 crsHitRadial p r = mapMaybe f . crsNearCirc p r
@@ -156,7 +165,7 @@ crsHitRadial p r = mapMaybe f . crsNearCirc p r
     f cr = do
         let cp = cr ^. crPos . _xy
         guard $ dist p cp < r + crRad (_crType cr)
-        return (cp + (1 + crRad (_crType cr)) *.* (cp - p), cr)
+        return (cp + (1 + crRad (_crType cr)) *^ (cp - p), cr)
 
 isFlyable :: Point2 -> Point2 -> World -> Bool
 {-# INLINE isFlyable #-}