Fix space leak (non-strict data fields)
This commit is contained in:
+11
-11
@@ -34,8 +34,7 @@ foldCr ::
|
|||||||
Creature ->
|
Creature ->
|
||||||
World ->
|
World ->
|
||||||
World
|
World
|
||||||
--foldCr xs cr w = foldr ($ cr) w xs
|
foldCr xs cr w = foldl' f w xs
|
||||||
foldCr xs cr w = foldl' f w $ reverse xs
|
|
||||||
where
|
where
|
||||||
f w' g = case w' ^? cWorld . creatures . ix (_crID cr) of
|
f w' g = case w' ^? cWorld . creatures . ix (_crID cr) of
|
||||||
Just cr' -> g cr' w'
|
Just cr' -> g cr' w'
|
||||||
@@ -51,15 +50,15 @@ foldCr xs cr w = foldl' f w $ reverse xs
|
|||||||
stateUpdate :: (Creature -> World -> World) -> Creature -> World -> World
|
stateUpdate :: (Creature -> World -> World) -> Creature -> World -> World
|
||||||
stateUpdate f =
|
stateUpdate f =
|
||||||
foldCr
|
foldCr
|
||||||
[ equipmentEffects
|
[ doDamage -- these three
|
||||||
, invSideEff
|
|
||||||
, upInv -- upInv must be called before invSideEff 22.05.23
|
|
||||||
, movementSideEff
|
|
||||||
, f
|
|
||||||
, internalUpdate
|
|
||||||
, clearDamage -- these three
|
|
||||||
, checkDeath -- must be in
|
, checkDeath -- must be in
|
||||||
, doDamage -- this order 22/06/05
|
, clearDamage -- this order 24/7/22
|
||||||
|
, internalUpdate
|
||||||
|
, f
|
||||||
|
, movementSideEff
|
||||||
|
, upInv -- upInv must be called before invSideEff 22.05.23
|
||||||
|
, invSideEff
|
||||||
|
, equipmentEffects
|
||||||
]
|
]
|
||||||
|
|
||||||
checkDeath :: Creature -> World -> World
|
checkDeath :: Creature -> World -> World
|
||||||
@@ -245,7 +244,8 @@ itemUpdate cr i
|
|||||||
| otherwise = baseupdate False
|
| otherwise = baseupdate False
|
||||||
where
|
where
|
||||||
baseupdate bool =
|
baseupdate bool =
|
||||||
updateAutoRecharge . (itUse %~ useUpdate)
|
updateAutoRecharge
|
||||||
|
. (itUse %~ useUpdate)
|
||||||
. (itLocation .~ InInv (_crID cr) i)
|
. (itLocation .~ InInv (_crID cr) i)
|
||||||
. (itIsHeld .~ bool)
|
. (itIsHeld .~ bool)
|
||||||
|
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
{-# LANGUAGE DeriveGeneric #-}
|
--{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE DeriveAnyClass #-}
|
--{-# LANGUAGE DeriveAnyClass #-}
|
||||||
--{-# LANGUAGE StrictData #-}
|
{-# LANGUAGE StrictData #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
module Dodge.Data.Item (
|
module Dodge.Data.Item (
|
||||||
|
|||||||
@@ -187,8 +187,12 @@ defaultImpulsive ::
|
|||||||
Creature ->
|
Creature ->
|
||||||
World ->
|
World ->
|
||||||
World
|
World
|
||||||
defaultImpulsive fs cr = updateRandGen -- . stateUpdate (const id) cr
|
defaultImpulsive
|
||||||
--fmap (fmap updateRandGen) . stateUpdate . impulsiveAIBefore . chainCreatureUpdates
|
--xs cr = id
|
||||||
|
-- updateRandGen -- . stateUpdate (const id) cr
|
||||||
|
= fmap (fmap updateRandGen) . stateUpdate . impulsiveAIBefore . chainCreatureUpdates
|
||||||
|
--xs cr = updateRandGen . stateUpdate (const id) cr
|
||||||
|
--xs cr = stateUpdate (const id) cr
|
||||||
where
|
where
|
||||||
updateRandGen w =
|
updateRandGen w =
|
||||||
let (_, g) = randomR (0, 1 :: Int) (_randGen w)
|
let (_, g) = randomR (0, 1 :: Int) (_randGen w)
|
||||||
|
|||||||
Reference in New Issue
Block a user