Change foldr to foldl' in some cases

src/Dodge/Base/Collide.hs

@@ -17,9 +17,9 @@ module Dodge.Base.Collide
     , wallsOnCirc
     , wallsOnLineHit
     , collideCircWalls
-    , collideCircWalls'
+--    , collideCircWalls'
     , circOnSomeWall
-    , collidePointWalls
+--    , collidePointWalls
     , collidePointWallsNorm
     , collidePointWalls'
     , collidePointWallsFilt'
@@ -383,21 +383,21 @@ collidePointWallsFilt' t p1 p2 = collidePointWalls p1 p2 . IM.filter t
 -- | Looks for first collision of a circle with walls.
 -- If found, gives point and reflection velocity, reflection damped in normal.
 -- note that the "intersection" point is the center of the circle flush against the wall
-collideCircWalls' :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
+--collideCircWalls' :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
-collideCircWalls' p1 p2 rad = either (const Nothing) Just . foldr findPoint (Left p2)
+--collideCircWalls' p1 p2 rad = either (const Nothing) Just . foldr findPoint (Left p2)
-  where 
+--  where 
-    findPoint wl eip = maybe eip Right $ doReflection (getp eip) $ shiftByRad $ _wlLine wl
+--    findPoint wl eip = maybe eip Right $ doReflection (getp eip) $ shiftByRad $ _wlLine wl
-    getp (Left p) = p
+--    getp (Left p) = p
-    getp (Right (p,_)) = p
+--    getp (Right (p,_)) = p
-    doReflection p (x,y) = case intersectSegSeg p1 p x y of
+--    doReflection p (x,y) = case intersectSegSeg p1 p x y of
-        Nothing -> Nothing
+--        Nothing -> Nothing
-        Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1))
+--        Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1))
-    shiftByRad (a,b) =
+--    shiftByRad (a,b) =
-        (g $ a +.+ rad *.* normalizeV (a -.-b)
+--        (g $ a +.+ rad *.* normalizeV (a -.-b)
-        ,g $ b +.+ rad *.* normalizeV (b -.-a)
+--        ,g $ b +.+ rad *.* normalizeV (b -.-a)
-        )
+--        )
-      where
+--      where
-        g = ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
+--        g = ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
 
 -- | Looks for first collision of a circle with walls.
 -- If found, gives point and reflection velocity, reflection damped in normal.

src/Dodge/Block/Debris.hs

@@ -16,6 +16,7 @@ import qualified Quaternion as Q
 
 import qualified Data.IntSet as IS
 import Data.Maybe
+import Data.Foldable
 
 makeDoorDebris :: Door -> World -> World
 makeDoorDebris dr w = w & makeDebris mt col p
@@ -47,7 +48,7 @@ makeDebrisDirected :: Float
     -> Point2 
     -> World -> World
 makeDebrisDirected mindist maxdist arcrad dir bm col p w = w
-        & flip (foldr (plNew props pjID)) thedebris
+        & flip (foldl' (flip $ plNew props pjID)) thedebris
         & randGen .~ newg
         & originsIDsAt [MaterialSound bm i | i <- [0,1,2]] (destroyMatS bm) p
   where

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -447,7 +447,7 @@ aTractorBeam _ cr w = w & plNew props pjID (tractorBeamAt spos outpos dir power)
     spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
     xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
     dir = _crDir cr
-    outpos = collidePointWalls cpos xpos
+    outpos = collidePointWalls' cpos xpos
         $ wallsAlongLine cpos xpos w
     power = _attractionPower . _itParams $ _crInv cr IM.! crSel cr
 

src/Dodge/Update.hs

@@ -151,11 +151,11 @@ zoneCreatures w = w
         cid = _crID cr
 
 updateCreatureSoundPositions :: World -> World
-updateCreatureSoundPositions w = M.foldrWithKey insertSound w 
+updateCreatureSoundPositions w = M.foldlWithKey' insertSound w 
     . M.mapMaybeWithKey updateSound 
     $ _playingSounds w
   where
-    insertSound k s = toPlaySounds %~ M.insertWith (const id) k s
+    insertSound w' k s = w' & toPlaySounds %~ M.insertWith (const id) k s
     updateSound (CrMouth cid) s = case w ^? creatures . ix cid . crPos of
         Just p  -> Just s {_soundPos = p, _soundAngDist = Just (soundAngle p w,0)}
         Nothing -> Just s {_soundTime = Just 0}

src/Dodge/WallCreatureCollisions.hs

@@ -38,7 +38,7 @@ colCrWall w c
     --c'  = c & crPos %~ pushOutFromWalls' rad (reverse ls)
     c'  = c & crPos %~ pushOutFromCorners rad ls'
         . pushOutFromWalls rad ls' 
-        . flip (collidePointWalls p1) wls  -- check push throughs
+        . flip (collidePointWalls' p1) wls  -- check push throughs
     rad = _crRad c + wallBuffer
     p1  = _crOldPos c
     p2  = _crPos c

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -80,8 +80,8 @@ moveFlame :: Point2   -- ^ Rotation direction
 moveFlame rotd w pt 
     | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing)
     | otherwise = case thingsHitExceptCr (_ptCrIgnore pt) sp ep w of
-        ((_,Left _):_)      -> (doSound $ damwls damcrs             , mvPt' 0.7)
+        ((_,Left _):_)      -> (doSound $ dodamage w             , mvPt' 0.7)
-        ((p,Right wl):_) -> (doSound $ damwls damcrs  , rfl wl p)
+        ((p,Right wl):_) -> (doSound $ dodamage w  , rfl wl p)
         _                   -> (ptFlicker pt . damwls $ doSound damcrs    , mvPt' 0.98)
   where 
     time = _ptTimer pt
@@ -94,6 +94,7 @@ moveFlame rotd w pt
         , _ptPos = ep
         , _ptCrIgnore = Nothing
         , _ptVel = speed *.* vel    }
+    dodamage = damageInArea closeCrs closeWls pt
     damwls w' = foldr (\wl -> fst . hiteff [(ep,Right wl)]) w' $ IM.filter closeWls $ wallsNearPoint ep w
     damcrs = foldr (\cr -> fst . hiteff [(ep,Left cr)]) w $ IM.filter closeCrs $ _creatures w
     closeWls wl = uncurry circOnSeg (_wlLine wl) ep 5
@@ -195,13 +196,18 @@ moveStaticBall = moveFlamelet
 
 -- | Note damgeInRadius by itself never destroys the particle
 damageInRadius :: Float -> Particle -> World -> World
-damageInRadius size pt w = damwls damcrs
+damageInRadius size pt = damageInArea isClose closeWls pt
   where
     p = _ptPos pt
-    damcrs = foldr (\cr -> fst . hiteff [(p,Left cr)]) w $ IM.filter isClose $ _creatures w
-    damwls w' = foldr (\wl -> fst . hiteff [(p,Right wl)]) w' $ IM.filter closeWls $ wallsNearPoint p w
     closeWls wl = uncurry circOnSeg (_wlLine wl) p size
     isClose cr = dist p (_crPos cr) < _crRad cr + size
+
+damageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Particle -> World -> World
+damageInArea crt wlt pt w = damwls damcrs
+  where
+    p = _ptPos pt
+    damcrs = foldr (\cr -> fst . hiteff [(p,Left cr)]) w $ IM.filter crt $ _creatures w
+    damwls w' = foldr (\wl -> fst . hiteff [(p,Right wl)]) w' $ IM.filter wlt $ wallsNearPoint p w
     hiteff = _ptHitEff pt pt
 
 -- | At writing the radius is half the size of the effect area