Remove Reader monad from multiple creature ais

2021-12-11 19:32:20 +00:00
parent 37b81c2967
commit c847955b7c
7 changed files with 78 additions and 131 deletions
@@ -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)
@@ -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'
@@ -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 $
-        performActionsR
-        >=> watchUpdateStratR
+    , _crUpdate = stateUpdate' $ impulsiveAI $ chainCreatureUpdatesLR
+        [ Left performActions
+        , Left $ watchUpdateStrat
            [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) 
                [DoActionIf (not . crIsAiming) drawWeapon
                ,DoActionThen 
@@ -41,13 +38,14 @@ ltAutoCrit = defaultCreature
              )
            , (crAwayFromPost, goToPostStrat)
            ]
-        >=> perceptionUpdate [0]
-        >=> doStrategyActionsR
-        >=> reloadOverrideR
-        >=> targetYouWhenCognizantR
-        >=> overrideInternalRRR
-            (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr)
-            (pure . (crActionPlan . crStrategy .~ WatchAndWait))
+        , Left $ perceptionUpdate' [0]
+        , Right $ doStrategyActions
+        , Right $ reloadOverride
+        , Left $ targetYouWhenCognizant
+        , Right $ overrideInternal
+            (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
+            (crActionPlan . crStrategy .~ WatchAndWait)
+        ]
    , _crActionPlan = ActionPlan
        { _crImpulse    = []
        , _crAction     = []
@@ -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 $
-         performActionsR
-        >=> watchUpdateStratR
+    , _crUpdate =  stateUpdate' $ impulsiveAI $ chainCreatureUpdatesLR
+        [Left performActions
+        ,Left $ watchUpdateStrat
              [ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0) 
                    [DoActionIf (not . crIsAiming) drawWeapon,chooseMovement cr w])
              , (crAwayFromPost, goToPostStrat)
              ]
-        >=> perceptionUpdate [0]
-        >=> doStrategyActionsR
-        >=> reloadOverrideR
-        >=> targetYouWhenCognizantR
-        >=> overrideInternalRRR
-            (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr)
-            (pure . (crActionPlan . crStrategy .~ WatchAndWait))
+        ,Left $ perceptionUpdate' [0]
+        ,Right $ doStrategyActions
+        ,Right $ reloadOverride
+        ,Left $ targetYouWhenCognizant
+        ,Right $ overrideInternal
+            (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
+            (crActionPlan . crStrategy .~ WatchAndWait)
+        ]
    , _crActionPlan = ActionPlan
        { _crImpulse    = []
        , _crAction     = []
@@ -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
-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 :: (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 ?~
@@ -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 $
-        performActionsR
-        >=> watchUpdateStratR
+    , _crUpdate = stateUpdate' $ impulsiveAI $ chainCreatureUpdatesLR
+        [Left performActions
+        ,Left $ watchUpdateStrat
          [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) 
              [DoActionIf (not . crIsAiming) drawWeapon
              ,DoActionThen 
@@ -42,13 +39,14 @@ spreadGunCrit = defaultCreature
            )
          , (crAwayFromPost, goToPostStrat)
          ]
-        >=> perceptionUpdate [0]
-        >=> doStrategyActionsR
-        >=> reloadOverrideR
-        >=> targetYouWhenCognizantR
-        >=> overrideInternalRRR
-            (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr)
-            (\ cr -> pure $ cr & crActionPlan . crStrategy .~ WatchAndWait)
+        ,Left $ perceptionUpdate' [0]
+        ,Right $ doStrategyActions
+        ,Right $ reloadOverride
+        ,Left $ targetYouWhenCognizant
+        ,Right $ overrideInternal
+            (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
+            (\ cr -> cr & crActionPlan . crStrategy .~ WatchAndWait)
+        ]
    , _crActionPlan = ActionPlan
        { _crImpulse    = []
        , _crAction     = []
@@ -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 $
-        flockToPointUsing (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9)
-        >=> return . (crMeleeCooldown %~ max 0 . subtract 1)
-        >=> perceptionUpdate [0]
-        >=> doStrategyActionsR
-        >=> targetYouWhenCognizantR
+    { _crUpdate =  stateUpdate' $ impulsiveAI $ chainCreatureUpdatesLR
+        [ Left $ flockToPointUsing' (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9)
+        , Right $ (crMeleeCooldown %~ max 0 . subtract 1)
+        , Left $ perceptionUpdate' [0]
+        , Right $ doStrategyActions
+        , Left $ targetYouWhenCognizant
+        ]
 --        , doStrategyActions
 --        , targetYouWhenCognizant