From 89dd8502ad0629a6202ad42e24351abc74a77a40 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 23 Jun 2022 21:46:46 +0100 Subject: [PATCH] Change foldr to foldl' in some cases --- src/Dodge/Base/Collide.hs | 34 +++++++++++++-------------- src/Dodge/Block/Debris.hs | 3 ++- src/Dodge/Item/Weapon/BatteryGuns.hs | 2 +- src/Dodge/Update.hs | 4 ++-- src/Dodge/WallCreatureCollisions.hs | 2 +- src/Dodge/WorldEvent/SpawnParticle.hs | 16 +++++++++---- 6 files changed, 34 insertions(+), 27 deletions(-) diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 69cc819a5..df01e24c9 100644 --- a/src/Dodge/Base/Collide.hs +++ b/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' p1 p2 rad = either (const Nothing) Just . foldr findPoint (Left p2) - where - findPoint wl eip = maybe eip Right $ doReflection (getp eip) $ shiftByRad $ _wlLine wl - getp (Left p) = p - getp (Right (p,_)) = p - doReflection p (x,y) = case intersectSegSeg p1 p x y of - Nothing -> Nothing - Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1)) - shiftByRad (a,b) = - (g $ a +.+ rad *.* normalizeV (a -.-b) - ,g $ b +.+ rad *.* normalizeV (b -.-a) - ) - where - g = ((rad *.* normalizeV (vNormal $ a -.- b)) +.+) +--collideCircWalls' :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2) +--collideCircWalls' p1 p2 rad = either (const Nothing) Just . foldr findPoint (Left p2) +-- where +-- findPoint wl eip = maybe eip Right $ doReflection (getp eip) $ shiftByRad $ _wlLine wl +-- getp (Left p) = p +-- getp (Right (p,_)) = p +-- doReflection p (x,y) = case intersectSegSeg p1 p x y of +-- Nothing -> Nothing +-- Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1)) +-- shiftByRad (a,b) = +-- (g $ a +.+ rad *.* normalizeV (a -.-b) +-- ,g $ b +.+ rad *.* normalizeV (b -.-a) +-- ) +-- where +-- 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. diff --git a/src/Dodge/Block/Debris.hs b/src/Dodge/Block/Debris.hs index 40a18d3b1..7a1577d55 100644 --- a/src/Dodge/Block/Debris.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 89fb1a04d..ad54d5709 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 6b1898574..a76e6ee99 100644 --- a/src/Dodge/Update.hs +++ b/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} diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index 059e788e1..738b4b303 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/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 diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 6d5088656..24521e396 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/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) - ((p,Right wl):_) -> (doSound $ damwls damcrs , rfl wl p) + ((_,Left _):_) -> (doSound $ dodamage w , mvPt' 0.7) + ((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