justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Replace some foldr with foldl'

Browse Source
This commit is contained in:
justin
2022-08-23 15:40:15 +01:00
parent 12ce2365c2
commit 9f00e67298
11 changed files with 35 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Barreloid.hs
+6 -6
View File
@@ -18,7 +18,7 @@ updateBarreloid cr = case cr ^?! crType . barrelType of
-- should generate the sparks externally using new random generators
updateExpBarrel :: Creature -> World -> World
updateExpBarrel cr w
| _crHP cr > 0 = foldr ($) (hiss w & cWorld . creatures . at (_crID cr) .~ newCr) pierceSparks
| _crHP cr > 0 = foldl' (flip ($)) (hiss w & cWorld . creatures . at (_crID cr) .~ newCr) pierceSparks
| otherwise = makeExplosionAt (_crPos cr) $ stopSounds w & cWorld . creatures . at (_crID cr) .~ Nothing
where
g = _randGen w
@@ -33,7 +33,7 @@ updateExpBarrel cr w
as = randomRs (-0.7, 0.7) g
colids = randomRs (0, 11) g
poss = _piercedPoints $ _csSpState $ _crState cr
newCr = Just $ applyFuseDamage $ set (crState . csDamage) [] $ damToExpBarrel damages cr
newCr = Just $ applyFuseDamage $ set (crState . csDamage) [] $ damsToExpBarrel damages cr
applyFuseDamage cr' =
cr' & crHP
%~ subtract (length . _piercedPoints . _csSpState $ _crState cr')
@@ -47,15 +47,15 @@ updateBarrel cr
| _crHP cr > 0 = doDamage cr
| otherwise = cWorld . creatures . at (_crID cr) .~ Nothing
damToExpBarrel :: [Damage] -> Creature -> Creature
damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
damsToExpBarrel :: [Damage] -> Creature -> Creature
damsToExpBarrel ds cr = foldl' damToExpBarrel (foldl' damToExpBarrel cr pierceDam) otherDam
where
(pierceDam, otherDam) = partition isPierce ds
isPierce Damage{_dmType = PIERCING{}} = True
isPierce _ = False
damToExpBarrel' :: Damage -> Creature -> Creature
damToExpBarrel' dm cr = case _dmType dm of
damToExpBarrel :: Creature -> Damage -> Creature
damToExpBarrel cr dm = case _dmType dm of
PIERCING ->
over (crState . csSpState . piercedPoints) ((:) $ int -.- _crPos cr) $
cr & crHP -~ div amount 200
src/Dodge/Block.hs
+7 -7
View File
@@ -23,7 +23,7 @@ import RandomHelp
splinterBlock :: Block -> World -> World
splinterBlock bl w =
foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardCen w (_blWallIDs bl)
foldl' unshadowBlock w (_blShadows bl) -- foldr shiftTowardCen w (_blWallIDs bl)
& originsIDsAt
[MaterialSound bm 0, MaterialSound bm 1, MaterialSound bm 2]
(weakenMatS bm)
@@ -34,8 +34,8 @@ splinterBlock bl w =
(wlid, _) <- IS.minView wlids
w ^? cWorld . walls . ix wlid . wlMaterial
unshadowBlock :: Int -> World -> World
unshadowBlock wlid w = case w ^? cWorld . walls . ix wlid of
unshadowBlock :: World -> Int -> World
unshadowBlock w wlid = case w ^? cWorld . walls . ix wlid of
Just wl ->
w
& cWorld . walls . ix wlid . wlUnshadowed .~ True
@@ -50,13 +50,13 @@ checkBlockHP bl
destroyBlock :: Block -> World -> World
destroyBlock bl w =
w
& flip (foldr unshadowBlock) (_blShadows bl)
& flip (foldl' unshadowBlock) (_blShadows bl)
& makeBlockDebris bl
& deleteWallIDs wlids
& maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted
& cWorld . blocks %~ IM.delete (_blID bl)
-- & matDesSound (_blMaterial bl) pos
& flip (foldr (wlDustAt awl)) (map (pos +.+) ps)
& flip (foldl' $ flip (wlDustAt awl)) (map (pos +.+) ps)
where
wlids = _blWallIDs bl
awl = _walls (_cWorld w) IM.! IS.findMin wlids
@@ -79,7 +79,7 @@ destroyDoor dr w =
& doDrWdWd (_drDeath dr) dr
& deleteWallIDs wlids
& cWorld . doors %~ IM.delete (_drID dr)
& flip (foldr (wlDustAt awl)) (map (pos +.+) ps)
& flip (foldl' (flip $ wlDustAt awl)) (map (pos +.+) ps)
& stopPushing (_drPushes dr)
& destroyMounts (_drMounts dr)
where
@@ -89,7 +89,7 @@ destroyDoor dr w =
ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
destroyMounts :: [MountedObject] -> World -> World
destroyMounts mos w = foldr destroyMount w mos
destroyMounts mos w = foldl' (flip destroyMount) w mos
destroyMount :: MountedObject -> World -> World
destroyMount mo = case mo of
src/Dodge/Block/Debris.hs
+1 -1
View File
@@ -26,7 +26,7 @@ makeDoorDebris dr w = w & makeDebris mt col p
return (_wlMaterial wl, _wlColor wl)
makeBlockDebris :: Block -> World -> World
makeBlockDebris bl w = foldr (makeDebris mt col) w ps
makeBlockDebris bl w = foldl' (flip $ makeDebris mt col) w ps
where
dsize = debrisSize mt
ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_blFootprint bl)
src/Dodge/Bullet.hs
+2 -1
View File
@@ -3,6 +3,7 @@ module Dodge.Bullet (
useAmmoParams,
) where
import Data.Foldable
import Data.Maybe
import Dodge.Base.Coordinate
import Dodge.Creature.HandPos
@@ -39,7 +40,7 @@ mvBullet x w bu
applyMagnetsToBul :: Bullet -> World -> Bullet
applyMagnetsToBul bu =
foldr (\mg -> doMagnetBuBu (_mgField mg) mg) bu . _magnets . _cWorld
foldl' (flip doMagnetBuBu) bu . _magnets . _cWorld
updateBulVel :: Bullet -> Bullet
updateBulVel bt = case _buTrajectory bt of
src/Dodge/Combine/Module.hs
+2 -2
View File
@@ -1,9 +1,9 @@
module Dodge.Combine.Module where
import Data.Foldable
import Dodge.Item.Targeting
import Dodge.Data.Beam
import Dodge.Data.Item
--import Dodge.Item.Weapon.ExtraEffect
import Dodge.Tesla
import Geometry
import LensHelp
@@ -53,4 +53,4 @@ moduleModification imt = case imt of
-- a = argV (mouseWorldPos w -.- p)
applyModules :: Item -> Item
applyModules it = foldr moduleModification it (_iyModules (_itType it))
applyModules it = foldl' (flip moduleModification) it (it ^. itType . iyModules)
src/Dodge/Creature/Impulse.hs
+2 -1
View File
@@ -4,6 +4,7 @@ module Dodge.Creature.Impulse (
impulsiveAIBefore,
) where
import Data.Foldable
import Control.Monad.State
import Data.Bifunctor
import Dodge.Creature.Impulse.Movement
@@ -29,7 +30,7 @@ impulsiveAIBefore f cr w = g w & cWorld . creatures . ix (_crID cr) .~ cr'
(g, cr') = followImpulses w $ f w cr
followImpulses :: World -> Creature -> (World -> World, Creature)
followImpulses w cr = foldr f (id, cr) (_apImpulse $ _crActionPlan cr)
followImpulses w cr = foldl' (flip f) (id, cr) (reverse $ _apImpulse $ _crActionPlan cr)
where
f imp (theupdate, cr') = first (. theupdate) $ followImpulse cr' w imp
src/Dodge/Creature/Impulse/UseItem.hs
+2 -1
View File
@@ -4,6 +4,7 @@ module Dodge.Creature.Impulse.UseItem (
itemEffect,
) where
import Data.Foldable
import Control.Lens
import qualified Data.Map.Strict as M
import Data.Maybe
@@ -29,7 +30,7 @@ useItem cr' w = fromMaybe (f w) $ do
itemEffect :: Creature -> Item -> World -> World
itemEffect cr it w = case it ^. itUse of
HeldUse{_heldUse = eff, _heldMods = usemods} ->
hammerTest $ tryReload cr it w $ foldr ($) (useHeld eff) (useMod usemods) it cr
hammerTest $ tryReload cr it w $ foldl' (flip ($)) (useHeld eff) (reverse $ useMod usemods) it cr
LeftUse{} -> doequipmentchange
EquipUse{} -> doequipmentchange
-- ConsumeUse will cause problems if the item is not selected
src/Dodge/Creature/State.hs
+6 -5
View File
@@ -3,6 +3,7 @@ module Dodge.Creature.State (
doDamage,
) where
import Data.Foldable
import Dodge.Base
import Dodge.Corpse.Make
import Dodge.Creature.Action
@@ -34,9 +35,9 @@ foldCr ::
World ->
World
--foldCr xs cr w = foldr ($ cr) w xs
foldCr xs cr w = foldr f w xs
foldCr xs cr w = foldl' f w $ reverse xs
where
f g w' = case w' ^? cWorld . creatures . ix (_crID cr) of
f w' g = case w' ^? cWorld . creatures . ix (_crID cr) of
Just cr' -> g cr' w'
Nothing -> w'
@@ -216,13 +217,13 @@ upInv cr = cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpda
-- a loop going over equipped items
equipmentEffects :: Creature -> World -> World
equipmentEffects cr = flip (foldr $ useEquipment cr) (IM.keys $ _crInvEquipped cr)
equipmentEffects cr = flip (foldl' $ flip $ useEquipment cr) (IM.keys $ _crInvEquipped cr)
-- a loop going over all inventory items
invSideEff :: Creature -> World -> World
invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
invSideEff cr w = weaponReloadSounds cr $ IM.foldlWithKey' f w (_crInv cr)
where
f i it w' =
f w' i it =
itemInvSideEffect cr it $
doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
src/Dodge/Creature/YourControl.hs
+2 -1
View File
@@ -2,6 +2,7 @@ module Dodge.Creature.YourControl (
yourControl,
) where
import Data.Foldable
import qualified Data.Map.Strict as M
import Dodge.Base.Coordinate
import Dodge.Creature.Impulse.Movement
@@ -72,7 +73,7 @@ wasdM scancode = case scancode of
_ -> V2 0 0
wasdDir :: World -> Point2
wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys
wasdDir = foldl' (flip $ (+.+) . wasdM) (V2 0 0) . _keys
-- | Set posture according to mouse presses.
mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature
src/Dodge/Damage.hs
+1 -1
View File
@@ -30,7 +30,7 @@ damageDirection ds = do
safeArgV (_dmTo dm -.- _dmFrom dm)
collectDamageTypes :: [Damage] -> M.Map DamageType Int
collectDamageTypes = foldr f M.empty
collectDamageTypes = foldl' (flip f) M.empty
where
f dm = M.insertWith (+) (_dmType dm) (_dmAmount dm)
src/Dodge/MagnetBuBu.hs
+4 -4
View File
@@ -4,8 +4,8 @@ import Dodge.Magnet
import Dodge.Data.Bullet
import Dodge.Data.Magnet
doMagnetBuBu :: MagnetBuBu -> Magnet -> Bullet -> Bullet
doMagnetBuBu mbb = case mbb of
MagnetBuId -> const id
MagnetBuBuCurveAroundField x y -> curveAroundField x y
doMagnetBuBu :: Magnet -> Bullet -> Bullet
doMagnetBuBu mg = case _mgField mg of
MagnetBuId -> id
MagnetBuBuCurveAroundField x y -> curveAroundField x y mg