Simplify creature impulse chain

src/Dodge/Creature/ChainUpdates.hs

@@ -3,11 +3,7 @@ module Dodge.Creature.ChainUpdates where
 import Data.Foldable
 import Dodge.Data.World
 
-chainCreatureUpdates ::
-    [World -> Creature -> Creature] ->
-    World ->
-    Creature ->
-    Creature
+chainCreatureUpdates :: [World -> Creature -> Creature] -> World -> Creature -> Creature
 chainCreatureUpdates ls w cr = foldl' unf cr ls
   where
     unf cr' g = g w cr'

src/Dodge/Creature/Impulse.hs

@@ -1,14 +1,13 @@
 {-# LANGUAGE TupleSections #-}
 
-module Dodge.Creature.Impulse (impulsiveAIBefore) where
+module Dodge.Creature.Impulse (followImpulses) where
 
 import Data.Maybe
-import Linear
 import NewInt
+import Linear
 import Dodge.Creature.MoveType
 import Data.Foldable
 import Control.Monad.State
-import Data.Bifunctor
 import Dodge.Creature.Impulse.Movement
 --import Dodge.Creature.Impulse.UseItem
 import Dodge.Creature.Vocalization
@@ -21,64 +20,59 @@ import Geometry
 import LensHelp
 import System.Random
 
-impulsiveAIBefore ::
-    (World -> Creature -> Creature) ->
-    Creature ->
-    World ->
-    World
-impulsiveAIBefore f cr w = g w & cWorld . lWorld . creatures . ix (_crID cr) .~ cr'
-  where
-    (g, cr') = followImpulses w $ f w cr
+--followImpulses :: World -> Creature -> (World -> World, Creature)
+--followImpulses w cr = foldl' (flip f) (id, cr) (reverse $ _apImpulse $ _crActionPlan cr)
+--  where
+--    f imp (theupdate, cr') = first (. theupdate) $ followImpulse cr' w imp
 
-followImpulses :: World -> Creature -> (World -> World, Creature)
-followImpulses w cr = foldl' (flip f) (id, cr) (reverse $ _apImpulse $ _crActionPlan cr)
-  where
-    f imp (theupdate, cr') = first (. theupdate) $ followImpulse cr' w imp
+followImpulses :: Int -> World -> World
+followImpulses cid w = foldl' (followImpulse cid) w 
+    (reverse $ w ^?! cWorld . lWorld . creatures . ix cid . crActionPlan . apImpulse)
 
 -- note SwitchToItem doesn't necessarily update the root item correctly
-followImpulse :: Creature -> World -> Impulse -> (World -> World, Creature)
-followImpulse cr w imp = case imp of
-    ImpulseNothing -> (id, cr)
+followImpulse :: Int -> World -> Impulse -> World
+followImpulse cid w imp = case imp of
+    ImpulseNothing -> w
     RandomImpulse rimp ->
         let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w)
-         in first ((randGen .~ newgen) .) $ followImpulse cr w newimp
-    Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown w cr)
-    Move p -> crup $ crMvBy p (w ^. cWorld . lWorld) cr
-    MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld) cr
-    MoveNoStride p -> crup $ crMvByNoStride p (w ^. cWorld . lWorld) cr
-    Turn a -> crup $ cr & crDir +~ a
-    TurnToward p a -> crup $ creatureTurnToward p a cr
-    TurnTo p -> crup $ creatureTurnTo p cr
-    ChangePosture post -> crup $ cr & crStance . posture .~ post
+         in randGen .~ newgen $ followImpulse cid w newimp
+    Bark sid -> soundStart (CrMouth cid) cpos sid Nothing 
+        $ w  & clens %~ resetCrVocCoolDown w
+    Move p -> crup $ crMvBy p (w ^. cWorld . lWorld)
+    MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld)
+    MoveNoStride p -> crup $ crMvByNoStride p (w ^. cWorld . lWorld)
+    Turn a -> crup $ crDir +~ a
+    TurnToward p a -> crup $ creatureTurnToward p a
+    TurnTo p -> crup $ creatureTurnTo p 
+    ChangePosture post -> crup $ crStance . posture .~ post
     UseItem -> undefined
---    UseItem -> (useSelectedItem $ _crID cr
---        , cr)
-    SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
+    SwitchToItem i -> crup $ crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
     Melee cid' ->
-        ( hitCr cid'
-        , crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
-        )
-    RandomTurn a -> (randGen .~ snd (rr a), cr & crDir +~ fst (rr a))
-    MakeSound sid -> (soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) sid Nothing, cr)
+        hitCr cid' $ crup (
+        (crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos))) . (crType . meleeCooldown .~ 20))
+    RandomTurn a -> let (aa,g) = rr a
+        in (randGen .~ g) (crup (crDir +~ aa))
+    MakeSound sid -> soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) sid Nothing w
     DropItem -> undefined
-    ChangeStrategy strat -> crup $ cr & crActionPlan . apStrategy .~ strat
-    AddGoal gl -> crup $ cr & crActionPlan . apGoal .:~ gl
-    ImpulseUseTarget f -> fromMaybe (crup cr) $ do
+    ChangeStrategy strat -> crup $ crActionPlan . apStrategy .~ strat
+    AddGoal gl -> crup $ crActionPlan . apGoal .:~ gl
+    ImpulseUseTarget f -> fromMaybe w $ do
         i <- cr ^? crIntention . targetCr . _Just
         tcr <- w ^? cWorld . lWorld . creatures . ix i
-        return $ followImpulse cr w (doCrImp f tcr)
-    MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) cr
+        return $ followImpulse cid w (doCrImp f tcr)
+    MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld)
     MvTurnToward _ _ _ p ->
         crup $
-            creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
+            creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir))
   where
-    crup = (id,)
+    clens = cWorld . lWorld . creatures . ix cid
+    cr = w ^?! cWorld . lWorld . creatures . ix cid
+    crup f = over clens f w
     mvType = crMvType cr
     speed = _mvSpeed mvType
     turnRad = doFloatFloat $ _mvTurnRad mvType
     cpos = cr ^. crPos . _xy
     cdir = _crDir cr
-    cid = _crID cr
     posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos . _xy
     rr a = randomR (- a, a) $ _randGen w
     hitCr i =

src/Dodge/Creature/Update.hs

@@ -47,7 +47,7 @@ updateCreature' cr =
         LampCrit{} -> updateLampoid cr
         BarrelCrit bt -> updateBarreloid bt cr
         AvatarDead -> id
-        ChaseCrit {} -> crUpdate cid .  updateHumanoid cr
+        ChaseCrit {} -> crUpdate cid . updateHumanoid cr
         _ -> crUpdate cid . updateHumanoid cr
   where
     cid = cr ^. crID

src/Dodge/Humanoid.hs

@@ -1,5 +1,6 @@
 module Dodge.Humanoid where
 
+import Dodge.Creature.Impulse
 import Linear
 import Data.Maybe
 import Dodge.Creature.Action
@@ -180,7 +181,10 @@ updateHumanoid cr = case cr ^?! crType of
 --        ]
 
 humanoidAIList :: [World -> Creature -> Creature] -> Creature -> World -> World
-humanoidAIList = impulsiveAIBefore . chainCreatureUpdates
+humanoidAIList l cr w = followImpulses cid $ 
+    w & cWorld . lWorld . creatures . ix cid %~ chainCreatureUpdates l w
+  where
+    cid = cr ^. crID
 
 chooseMovementPistol :: Creature -> World -> Action
 chooseMovementPistol cr w =