Remove Reader monad from multiple creature ais

src/Dodge/Creature/Boid.hs

@@ -215,6 +215,18 @@ flockToPointUsing pf mvf cr = reader $ \w -> case _targetCr $ _crIntention cr of
       where
         cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr)
         ptarg = pf tcr cenp cr
+flockToPointUsing'
+    :: (Creature -> Point2 -> Creature -> Point2)
+    -> (Point2 -> Creature -> Creature -> [Impulse])
+    -> World
+    -> Creature
+    -> Creature
+flockToPointUsing' pf mvf w cr = case _targetCr $ _crIntention cr of
+    Nothing -> cr
+    Just tcr -> cr & crActionPlan . crImpulse .~ mvf ptarg cr tcr
+      where
+        cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr)
+        ptarg = pf tcr cenp cr
 
 flockFunc
     :: (Creature -> Point2 -> Creature -> Point2)

src/Dodge/Creature/ChainUpdates.hs

@@ -0,0 +1,19 @@
+module Dodge.Creature.ChainUpdates where
+import Dodge.Data
+
+import Data.Foldable
+chainCreatureUpdatesLR' 
+    :: [Either (World -> Creature -> Creature) (Creature -> Creature)] 
+    -> World -> Creature -> Creature
+chainCreatureUpdatesLR' ls w cr = foldr unf cr ls
+  where
+    unf (Left g) = g w
+    unf (Right g) = g
+
+chainCreatureUpdatesLR
+    :: [Either (World -> Creature -> Creature) (Creature -> Creature)] 
+    -> World -> Creature -> Creature
+chainCreatureUpdatesLR ls w cr = foldl' unf cr ls
+  where
+    unf cr' (Left g) = g w cr'
+    unf cr' (Right g) = g cr'

src/Dodge/Creature/LtAutoCrit.hs

@@ -4,6 +4,7 @@ module Dodge.Creature.LtAutoCrit
 import Dodge.Data
 import Dodge.Default
 import Dodge.Creature.Picture
+import Dodge.Creature.ChainUpdates
 import Dodge.Creature.Impulse
 import Dodge.Creature.Action
 import Dodge.Creature.Test
@@ -18,20 +19,16 @@ import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Consumable
 import Geometry
 import Picture
---import Dodge.RandomHelp
 
---import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
-import Control.Monad.Reader
---import System.Random
 
 ltAutoCrit :: Creature
 ltAutoCrit = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate $ impulsiveAIR $
+    , _crUpdate = stateUpdate' $ impulsiveAI $ chainCreatureUpdatesLR
-        performActionsR
+        [ Left performActions
-        >=> watchUpdateStratR
+        , Left $ watchUpdateStrat
             [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) 
                 [DoActionIf (not . crIsAiming) drawWeapon
                 ,DoActionThen 
@@ -41,13 +38,14 @@ ltAutoCrit = defaultCreature
               )
             , (crAwayFromPost, goToPostStrat)
             ]
-        >=> perceptionUpdate [0]
+        , Left $ perceptionUpdate' [0]
-        >=> doStrategyActionsR
+        , Right $ doStrategyActions
-        >=> reloadOverrideR
+        , Right $ reloadOverride
-        >=> targetYouWhenCognizantR
+        , Left $ targetYouWhenCognizant
-        >=> overrideInternalRRR
+        , Right $ overrideInternal
-            (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr)
+            (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
-            (pure . (crActionPlan . crStrategy .~ WatchAndWait))
+            (crActionPlan . crStrategy .~ WatchAndWait)
+        ]
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
         , _crAction     = []

src/Dodge/Creature/PistolCrit.hs

@@ -10,7 +10,7 @@ import Dodge.Creature.Action
 import Dodge.Creature.Volition
 import Dodge.Creature.Strategy
 import Dodge.Creature.ReaderUpdate
---import Dodge.Creature.ChooseTarget
+import Dodge.Creature.ChainUpdates
 import Dodge.Creature.Perception
 import Dodge.Creature.State
 --import Dodge.Creature.State.Data
@@ -29,20 +29,21 @@ import Control.Monad.State
 pistolCrit :: Creature
 pistolCrit = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate =  stateUpdate $ impulsiveAIR $
+    , _crUpdate =  stateUpdate' $ impulsiveAI $ chainCreatureUpdatesLR
-         performActionsR
+        [Left performActions
-        >=> watchUpdateStratR
+        ,Left $ watchUpdateStrat
               [ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0) 
                     [DoActionIf (not . crIsAiming) drawWeapon,chooseMovement cr w])
               , (crAwayFromPost, goToPostStrat)
               ]
-        >=> perceptionUpdate [0]
+        ,Left $ perceptionUpdate' [0]
-        >=> doStrategyActionsR
+        ,Right $ doStrategyActions
-        >=> reloadOverrideR
+        ,Right $ reloadOverride
-        >=> targetYouWhenCognizantR
+        ,Left $ targetYouWhenCognizant
-        >=> overrideInternalRRR
+        ,Right $ overrideInternal
-            (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr)
+            (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
-            (pure . (crActionPlan . crStrategy .~ WatchAndWait))
+            (crActionPlan . crStrategy .~ WatchAndWait)
+        ]
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
         , _crAction     = []

src/Dodge/Creature/ReaderUpdate.hs

@@ -1,25 +1,17 @@
 {- | Functions updating a creature in a Reader World environment -}
 module Dodge.Creature.ReaderUpdate
-    ( doStrategyActionsR
+    ( doStrategyActions
-    , doStrategyActions
     , setTargetMv
-    , targetYouWhenCognizantR
     , targetYouWhenCognizant
-    , overrideMeleeCloseTargetR
     , overrideMeleeCloseTarget
-    , watchUpdateStratR
     , watchUpdateStrat
-    , reloadOverrideR
     , reloadOverride
-    , overrideInternalRRR
     , overrideInternal
     , goToTarget
-    , flockACCR
     , flockACC
     , setMvPos
     , setViewPos
-    )
+    ) where
-    where
 import Dodge.Data
 import Dodge.Creature.Test
 import Dodge.Creature.Volition
@@ -29,16 +21,10 @@ import Geometry
 import FoldableHelp
 
 import qualified Data.IntMap.Strict as IM
-import Control.Monad.Reader
 import Control.Lens
 import Control.Applicative
 import Data.Maybe
 
-overrideMeleeCloseTargetR 
-    :: Creature 
-    -> Reader World Creature
-overrideMeleeCloseTargetR cr = return $ maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
-
 overrideMeleeCloseTarget :: Creature -> Creature
 overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
 
@@ -73,29 +59,6 @@ setTargetMv targFunc w cr = maybe
     (\ctarg -> cr & crIntention . mvToPoint ?~ _crPos ctarg)
     (targFunc w cr)
 
-flockACCR :: Creature -> Reader World Creature
-flockACCR cr = do
-    case cr ^? crIntention . targetCr . _Just of
-        Nothing -> pure cr
-        Just tcr -> do
-            w <- ask
-            let tpos = _crPos tcr
-                cpos = _crPos cr
-                isFarACC cr' = _crGroup cr' == _crGroup cr 
-                    && _crID cr' /= _crID cr
-                    && dist (_crPos cr') tpos > dist cpos tpos
-                nearACCs = IM.filter isFarACC $ creaturesNearPointI 5 cpos w
-                macr = safeMinimumOn (dist cpos . _crPos) nearACCs
-            case macr of
-                Nothing  -> pure cr
-                Just acr -> do
-                    let r = _crRad acr + _crRad cr + 10
-                        horDir = normalizeV (vNormal (cpos -.- tpos))
-                        horShift = if isLHS tpos cpos (_crPos acr)
-                            then r *.* horDir
-                            else negate r *.* horDir
-                    pure $ cr & crIntention . mvToPoint ?~ tpos +.+ horShift
-
 -- fugly
 flockACC :: World -> Creature -> Creature
 flockACC w cr = case cr ^? crIntention . targetCr . _Just of
@@ -139,12 +102,6 @@ replaceNullWith :: a -> [a] -> [a]
 replaceNullWith x [] = [x]
 replaceNullWith _ xs = xs
     
-doStrategyActionsR :: Creature -> Reader World Creature
-doStrategyActionsR cr = return $ case cr ^? crActionPlan . crStrategy of
-    Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs
-        & crActionPlan . crStrategy .~ strat
-    _ -> cr
-
 doStrategyActions :: Creature -> Creature
 doStrategyActions cr = case cr ^? crActionPlan . crStrategy of
     Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs
@@ -163,45 +120,11 @@ reloadOverride cr
         , WaitThen 1 $ DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait])
         ]
 
-reloadOverrideR :: Creature -> Reader World Creature
+overrideInternal :: (Creature -> Bool) -> (Creature -> Creature) -> Creature -> Creature
-reloadOverrideR cr
-    | cr ^? crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded == Just 0 
-            && cr ^. crStance . posture == Aiming
-        = return $ cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions
-    | otherwise = return cr
-  where
-    reloadActions = 
-        [ holsterWeapon
-        , WaitThen 1 $ DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait])
-        ]
-
-overrideInternalRRR
-    :: (Creature -> Reader World Bool)
-    -> (Creature -> Reader World Creature)
-    -> Creature
-    -> Reader World Creature
-overrideInternalRRR test update cr = do
-    b <- test cr
-    if b then update cr else pure cr
-
-overrideInternal
-    :: (Creature -> Bool)
-    -> (Creature -> Creature)
-    -> Creature
-    -> Creature
 overrideInternal test update cr
     | test cr = update cr
     | otherwise = cr
 
-watchUpdateStratR
-    :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ]
-    -> Creature
-    -> Reader World Creature
-watchUpdateStratR fs cr = reader $ \w -> case cr ^? crActionPlan . crStrategy of
-    Just WatchAndWait -> cr 
-        & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr
-    _ -> cr
-
 watchUpdateStrat
     :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ]
     -> World
@@ -218,11 +141,6 @@ listGuard ( (test,y):ps, z ) x
     | otherwise = listGuard (ps, z) x
 listGuard (_,z) _ = z
 
-targetYouWhenCognizantR :: Creature -> Reader World Creature
-targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crPerception . crAwarenessLevel . ix 0 of
-    Just (Cognizant _)  -> cr & crIntention . targetCr ?~ _creatures w IM.! 0
-    _                   -> cr & crIntention . targetCr .~ Nothing
-
 targetYouWhenCognizant :: World -> Creature -> Creature
 targetYouWhenCognizant w cr = case cr ^? crPerception . crAwarenessLevel . ix 0 of
 -- so this caused a space leak: be careful with ?~

src/Dodge/Creature/SpreadGunCrit.hs

@@ -10,7 +10,7 @@ import Dodge.Creature.Action
 import Dodge.Creature.Volition
 import Dodge.Creature.Strategy
 import Dodge.Creature.ReaderUpdate
---import Dodge.Creature.ChooseTarget
+import Dodge.Creature.ChainUpdates
 import Dodge.Creature.Perception
 import Dodge.Creature.State
 --import Dodge.Creature.State.Data
@@ -23,16 +23,13 @@ import Picture
 --import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
-import Control.Monad
---import Control.Monad.Trans.Reader
---import System.Random
 
 spreadGunCrit :: Creature
 spreadGunCrit = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate $ impulsiveAIR $
+    , _crUpdate = stateUpdate' $ impulsiveAI $ chainCreatureUpdatesLR
-        performActionsR
+        [Left performActions
-        >=> watchUpdateStratR
+        ,Left $ watchUpdateStrat
           [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) 
               [DoActionIf (not . crIsAiming) drawWeapon
               ,DoActionThen 
@@ -42,13 +39,14 @@ spreadGunCrit = defaultCreature
             )
           , (crAwayFromPost, goToPostStrat)
           ]
-        >=> perceptionUpdate [0]
+        ,Left $ perceptionUpdate' [0]
-        >=> doStrategyActionsR
+        ,Right $ doStrategyActions
-        >=> reloadOverrideR
+        ,Right $ reloadOverride
-        >=> targetYouWhenCognizantR
+        ,Left $ targetYouWhenCognizant
-        >=> overrideInternalRRR
+        ,Right $ overrideInternal
-            (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr)
+            (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
-            (\ cr -> pure $ cr & crActionPlan . crStrategy .~ WatchAndWait)
+            (\ cr -> cr & crActionPlan . crStrategy .~ WatchAndWait)
+        ]
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
         , _crAction     = []

src/Dodge/Creature/SwarmCrit.hs

@@ -5,6 +5,7 @@ module Dodge.Creature.SwarmCrit
 import Dodge.Data
 import Dodge.Default
 import Dodge.Creature.Picture
+import Dodge.Creature.ChainUpdates
 import Dodge.Creature.Boid
 import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Perception
@@ -14,16 +15,16 @@ import Dodge.Picture.Layer
 import Picture
 
 import Control.Lens
-import Control.Monad.Reader
 
 swarmCrit :: Creature
 swarmCrit = defaultCreature
-    { _crUpdate =  stateUpdate $ impulsiveAIR $
+    { _crUpdate =  stateUpdate' $ impulsiveAI $ chainCreatureUpdatesLR
-        flockToPointUsing (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9)
+        [ Left $ flockToPointUsing' (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9)
-        >=> return . (crMeleeCooldown %~ max 0 . subtract 1)
+        , Right $ (crMeleeCooldown %~ max 0 . subtract 1)
-        >=> perceptionUpdate [0]
+        , Left $ perceptionUpdate' [0]
-        >=> doStrategyActionsR
+        , Right $ doStrategyActions
-        >=> targetYouWhenCognizantR
+        , Left $ targetYouWhenCognizant
+        ]
 --        , doStrategyActions
 --        , targetYouWhenCognizant