Move towards a simplified creature update

src/Dodge/Creature.hs

@@ -11,7 +11,7 @@ module Dodge.Creature
     , smallChaseCrit
     )
   where
---import Dodge.Creature.Stance.Data
+import Dodge.RemoveCreatureEndo
 import Dodge.Creature.State.Data
 --import Dodge.Item.Weapon.Grenade
 import Dodge.Item.Weapon.Booster
@@ -70,7 +70,7 @@ spawnerCrit = defaultCreature
 miniGunCrit :: Creature
 miniGunCrit = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate $ impulsiveAIR $
+    , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $
         sentinelFireType (const shootTillEmpty)
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
@@ -89,7 +89,7 @@ longCrit :: Creature
 longCrit = defaultCreature
     { _crPict = basicCrPict red
 --    , _crUpdate = stateUpdate sniperAI
-    , _crUpdate = stateUpdate $ impulsiveAIR $ sentinelFireType $ const shootTillEmpty
+    , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $ sentinelFireType $ const shootTillEmpty
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
         , _crAction     = []
@@ -109,7 +109,7 @@ multGunCrit = defaultCreature
     , _crInvSel = 0
     , _crRad = 10
     , _crHP = 300
-    , _crUpdate = stateUpdate $ impulsiveAIR $ sentinelExtraWatchUpdate
+    , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $ sentinelExtraWatchUpdate
             [ ( not . crHasAmmo
               , \_ _ -> StrategyActions Reload reloadActions
               )
@@ -150,7 +150,7 @@ startCr = defaultCreature
     , _crMvDir  = pi/2
     , _crID = 0
     , _crPict = basicCrPict black
-    , _crUpdate = stateUpdate yourControl
+    , _crUpdate = toCrUpdate $ stateUpdate yourControl
     , _crRad = 10
     , _crMass = 10
     , _crHP = 1000

src/Dodge/Creature/ArmourChase.hs

@@ -1,8 +1,8 @@
 module Dodge.Creature.ArmourChase
     ( armourChaseCrit
-    )
+    ) where
-    where
 import Dodge.Data
+import Dodge.RemoveCreatureEndo
 import Dodge.Default
 import Dodge.Creature.State
 import Dodge.Creature.ReaderUpdate
@@ -20,7 +20,7 @@ import Control.Monad.Reader
 
 armourChaseCrit :: Creature
 armourChaseCrit = defaultCreature
-    { _crUpdate = stateUpdate $ impulsiveAIR $ 
+    { _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $ 
         watchUpdateStratR [] >=>
         doStrategyActionsR >=>
         performActionsR >=>

src/Dodge/Creature/AutoCrit.hs

@@ -2,6 +2,7 @@ module Dodge.Creature.AutoCrit
     ( autoCrit 
     ) where
 import Dodge.Data
+import Dodge.RemoveCreatureEndo
 import Dodge.Default
 import Dodge.Creature.Picture
 import Dodge.Creature.SentinelAI
@@ -21,7 +22,7 @@ import qualified Data.IntMap.Strict as IM
 autoCrit :: Creature
 autoCrit = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate $ impulsiveAIR sentinelAI
+    , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR sentinelAI
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
         , _crAction     = []

src/Dodge/Creature/ChaseCrit.hs

@@ -3,6 +3,7 @@ module Dodge.Creature.ChaseCrit
     ,chaseCrit
     ) where
 import Dodge.Data
+import Dodge.RemoveCreatureEndo
 import Dodge.Default
 import Dodge.Creature.Picture
 import Dodge.Creature.ReaderUpdate
@@ -33,7 +34,7 @@ smallChaseCrit = chaseCrit
     }
 chaseCrit :: Creature
 chaseCrit = defaultCreature
-    { _crUpdate = stateUpdate $ --dummyUpdate
+    { _crUpdate = toCrUpdate $ stateUpdate $ --dummyUpdate
         impulsiveAIR $ 
         doStrategyActionsR >=>
         performActionsR >=>

src/Dodge/Creature/Inanimate.hs

@@ -9,6 +9,7 @@ module Dodge.Creature.Inanimate
     , explosiveBarrel
     ) where
 import Dodge.Data
+import Dodge.RemoveCreatureEndo
 import Dodge.WorldEvent.Explosion
 import Dodge.Creature.Picture
 --import Dodge.Creature.Stance.Data
@@ -42,7 +43,7 @@ colorLamp
     -> Float    -- height of lamp
     -> Creature
 colorLamp col h = defaultInanimate
-    { _crUpdate = initialiseColorLamp col h
+    { _crUpdate = toCrUpdate $ initialiseColorLamp col h
     , _crHP = 100
     , _crPict = picAtCrPosNoRot (lampCrPic h)
     , _crRad = 3
@@ -51,7 +52,7 @@ colorLamp col h = defaultInanimate
 
 lamp :: Float -> Creature
 lamp h = defaultInanimate
-    { _crUpdate = initialiseLamp h
+    { _crUpdate = toCrUpdate $ initialiseLamp h
     , _crHP = 100
     , _crPict = picAtCrPosNoRot (lampCrPic h)
     , _crRad = 3
@@ -83,12 +84,12 @@ initialiseLamp :: Float -> CRUpdate
 initialiseLamp = initialiseColorLamp 0.75
 
 initialiseColorLamp :: Point3 -> Float -> CRUpdate
-initialiseColorLamp col h cr _ = ( Endo addLS , Just $ cr & crUpdate .~ updateLamp h i)
+initialiseColorLamp col h cr _ = ( Endo addLS , Just $ cr & crUpdate .~ toCrUpdate (updateLamp h i))
   where
     i = _crID cr
     addLS w = w
         & lightSources %~ IM.insert lsid (lsColPosID col (V3 x y h) lsid)
-        & creatures . ix i . crUpdate .~ updateLamp h lsid
+        & creatures . ix i . crUpdate .~ toCrUpdate (updateLamp h lsid)
       where
         lsid = IM.newKey $ _lightSources w
     (V2 x y) = _crPos cr
@@ -109,7 +110,7 @@ updateLamp h i = unrandUpdate handleLS internalUpdate
 
 barrel :: Creature
 barrel = defaultInanimate
-    { _crUpdate = updateBarrel
+    { _crUpdate = toCrUpdate updateBarrel
     , _crHP = 500
     , _crPict = picAtCrPos $ onLayer CrLayer $ pictures 
         [ color orange $ circleSolid 10
@@ -124,7 +125,7 @@ barrel = defaultInanimate
 
 explosiveBarrel :: Creature
 explosiveBarrel = defaultInanimate
-    { _crUpdate = updateExpBarrel
+    { _crUpdate = toCrUpdate updateExpBarrel
     , _crHP = 400
     , _crPict = shapeAtCrPos
         . colorSH orange

src/Dodge/Creature/LauncherCrit.hs

@@ -3,6 +3,7 @@ module Dodge.Creature.LauncherCrit
     )
     where
 import Dodge.Data
+import Dodge.RemoveCreatureEndo
 import Dodge.Default
 import Dodge.Creature.Picture
 import Dodge.Creature.Test
@@ -24,7 +25,7 @@ import Control.Monad.Reader
 launcherCrit :: Creature
 launcherCrit = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate $ impulsiveAIR $
+    , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $
         performActionsR
         >=> watchUpdateStratR
             [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFire])

src/Dodge/Creature/LtAutoCrit.hs

@@ -2,6 +2,7 @@ module Dodge.Creature.LtAutoCrit
     ( ltAutoCrit 
     ) where
 import Dodge.Data
+import Dodge.RemoveCreatureEndo
 import Dodge.Default
 import Dodge.Creature.Picture
 import Dodge.Creature.Impulse
@@ -29,7 +30,7 @@ import Control.Monad.Reader
 ltAutoCrit :: Creature
 ltAutoCrit = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate $ impulsiveAIR $
+    , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $
         performActionsR
         >=> watchUpdateStratR
             [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) 

src/Dodge/Creature/PistolCrit.hs

@@ -2,6 +2,7 @@ module Dodge.Creature.PistolCrit
     ( pistolCrit 
     ) where
 import Dodge.Data
+import Dodge.RemoveCreatureEndo
 import Dodge.Default
 import Dodge.Creature.Picture
 import Dodge.Creature.Test
@@ -29,7 +30,7 @@ import Control.Monad.State
 pistolCrit :: Creature
 pistolCrit = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate $ impulsiveAIR $
+    , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $
          performActionsR
         >=> watchUpdateStratR
               [ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0) 

src/Dodge/Creature/SpreadGunCrit.hs

@@ -2,6 +2,7 @@ module Dodge.Creature.SpreadGunCrit
     ( spreadGunCrit 
     ) where
 import Dodge.Data
+import Dodge.RemoveCreatureEndo
 import Dodge.Default
 import Dodge.Creature.Picture
 import Dodge.Creature.Test
@@ -30,7 +31,7 @@ import Control.Monad
 spreadGunCrit :: Creature
 spreadGunCrit = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate $ impulsiveAIR $
+    , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $
         performActionsR
         >=> watchUpdateStratR
           [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) 

src/Dodge/Creature/SwarmCrit.hs

@@ -3,6 +3,7 @@ module Dodge.Creature.SwarmCrit
     )
     where
 import Dodge.Data
+import Dodge.RemoveCreatureEndo
 import Dodge.Default
 import Dodge.Creature.Picture
 import Dodge.Creature.Boid
@@ -18,7 +19,7 @@ import Control.Monad.Reader
 
 swarmCrit :: Creature
 swarmCrit = defaultCreature
-    { _crUpdate = stateUpdate $ impulsiveAIR $
+    { _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $
         flockToPointUsing (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9)
         >=> return . (crMeleeCooldown %~ max 0 . subtract 1)
         >=> perceptionUpdate [0]

src/Dodge/Data.hs

@@ -229,7 +229,8 @@ data Creature = Creature
     , _crTwist          :: Float
     , _crID             :: Int
     , _crPict           :: Creature -> Configuration -> World -> SPic
-    , _crUpdate         :: Creature -> World -> (Endo World, Maybe Creature)
+    --, _crUpdate         :: Creature -> World -> (Endo World, Maybe Creature)
+    , _crUpdate         :: Creature -> World -> World
     , _crRad            :: Float
     , _crMass           :: Float
     , _crHP             :: Int

src/Dodge/Debug/Terminal.hs

@@ -1,6 +1,7 @@
 module Dodge.Debug.Terminal
     where
 import Dodge.Data
+import Dodge.RemoveCreatureEndo
 import Dodge.Creature
 import Dodge.Creature.YourControl
 import Dodge.Creature.State
@@ -11,8 +12,8 @@ applyTerminalString :: String -> Universe -> Universe
 applyTerminalString "NOCLIP" w = w & config . debug_noclip %~ not
 applyTerminalString "LOADME" w = w & uvWorld . creatures . ix 0 . crInv .~ stackedInventory
     & uvWorld . creatures . ix 0 . crInvCapacity .~ 50
-applyTerminalString "GODON" u = u & uvWorld . creatures . ix 0 . crUpdate .~ stateUpdateDamage clearDamage yourControl
+applyTerminalString "GODON" u = u & uvWorld . creatures . ix 0 . crUpdate .~ toCrUpdate (stateUpdateDamage clearDamage yourControl)
-applyTerminalString "GODOFF" u = u & uvWorld . creatures . ix 0 . crUpdate .~ stateUpdate yourControl
+applyTerminalString "GODOFF" u = u & uvWorld . creatures . ix 0 . crUpdate .~ toCrUpdate (stateUpdate yourControl)
 applyTerminalString "LOADTEST" w = w & uvWorld . creatures . ix 0 . crInv .~ testInventory
     & uvWorld . creatures . ix 0 . crInvCapacity .~ 50
 applyTerminalString "LM" w = applyTerminalString "LOADME" w

src/Dodge/Default.hs

@@ -19,7 +19,7 @@ import Control.Lens
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Vector as V
 import Data.List
-import Data.Monoid
+--import Data.Monoid
 defaultCreature :: Creature
 defaultCreature = Creature
     { _crPos    = V2 0 0
@@ -31,7 +31,7 @@ defaultCreature = Creature
     , _crTwist  = 0
     , _crID     = 1
     , _crPict   = \_ _ _ -> (,) mempty blank
-    , _crUpdate = \cr _ -> (Endo id , Just cr)
+    , _crUpdate = const id
     , _crRad    = 10
     , _crMass   = 10
     , _crHP     = 100

src/Dodge/Update.hs

@@ -25,8 +25,8 @@ import qualified Data.IntMap.Strict as IM
 import qualified Data.Map.Strict as M
 --import qualified Data.Set as S
 import Control.Lens
-import Data.Monoid
+--import Data.Monoid
-import System.Random
+--import System.Random
 
 {- For most menus the only way to change the world is using event handling.  -}
 updateUniverse :: Universe -> Universe
@@ -65,7 +65,8 @@ functionalUpdate cfig w = checkEndGame
     . zoneClouds
     . updateMIM magnets _mgUpdate
     . updateIMl _machines _mcUpdate
-    . updateCreatures 
+    . updateIMl _creatures _crUpdate
+   -- . updateCreatures 
     . updateCreatureGroups
     . updateBlocks
     . updateSeenWalls 
@@ -144,16 +145,16 @@ updateMIM :: ASetter' World (IM.IntMap a) -> (a -> a -> Maybe a) -> World -> Wor
 updateMIM f up w = w & f %~ IM.mapMaybe (dbArg up)
 
 -- Note that this updates the randgen
-updateCreatures :: World -> World
+--updateCreatures :: World -> World
-updateCreatures w = appEndo f $ w 
+--updateCreatures w = appEndo f $ w 
-    & creatures .~ IM.mapMaybe id m
+--    & creatures .~ IM.mapMaybe id m
-    & randGen   .~ newg
+--    & randGen   .~ newg
-  where
+--  where
-    ((f,newg),m) = mapAccumR crUp (Endo id,_randGen w) (_creatures w)
+--    ((f,newg),m) = mapAccumR crUp (Endo id,_randGen w) (_creatures w)
-    crUp (f',g) cr = ((f' <> f'',g'), cr')
+--    crUp (f',g) cr = ((f' <> f'',g'), cr')
-      where
+--      where
-        (f'',cr') = _crUpdate cr cr (w & randGen .~ g)
+--        (f'',cr') = _crUpdate cr cr (w & randGen .~ g)
-        (_,g') = genWord8 g
+--        (_,g') = genWord8 g
 
 ppEvents :: World -> World
 ppEvents w = IM.foldl' (flip $ \pp -> _ppEvent pp pp) w $ _pressPlates w