Add jitter on chase crit bark

src/Dodge/Creature/Action.hs

@@ -40,6 +40,7 @@ import Control.Lens
 --import Control.Monad
 --import Control.Applicative
 import Data.Maybe
+import Data.Bifunctor
 import Data.List (findIndex)
 --import qualified Data.Map as M
 performActions :: World -> Creature -> Creature
@@ -102,6 +103,7 @@ performTurnToA cr p
 -- doAction -}
 performAction :: Creature -> World -> Action -> OutAction
 performAction cr w ac = case ac of
+    LabelAction str subAc -> second (fmap (LabelAction str)) $ performAction cr w subAc
     AimAt tcid p -> performAimAt cr w tcid p
     WaitThen 0 newAc -> ([] , Just newAc)
     WaitThen t newAc -> ([] , Just (WaitThen (t-1) newAc))

src/Dodge/Creature/Impulse.hs

@@ -13,6 +13,7 @@ import LensHelp
 
 import qualified Data.IntMap.Strict as IM
 import System.Random
+import Control.Monad.State
 import Data.Bifunctor
 --import Data.Maybe
 --
@@ -49,6 +50,9 @@ followImpulses w cr = foldr f (id, cr) (_crImpulse $ _crActionPlan cr)
 
 followImpulse :: Creature -> World -> Impulse -> (World -> World , Creature)
 followImpulse cr w imp = case imp of
+    RandomImpulse rimp -> 
+        let (newimp,newgen) = runState rimp (_randGen w)
+        in first ((randGen .~ newgen) .) $ followImpulse cr w newimp
     Bark sid        -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr)
     Move p          -> crup $ crMvBy p cr
     MoveForward x   -> crup $ crMvForward x cr

src/Dodge/Creature/Perception.hs

@@ -33,7 +33,7 @@ chaseCritPerceptionUpdate is w =
     rememberSounds w . chaseCritAwarenessUpdate w . basicAttentionUpdate is w
 
 {- | Update a creatures awareness based upon the creatures' current direction
- of attention -}
+ of attention -} -- TODO delete?
 basicAwarenessUpdate :: Creature -> Creature
 basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of
     Fixated i -> cr & crPerception . crAwarenessLevel 
@@ -46,10 +46,23 @@ basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of
         oldAwareness = _crAwarenessLevel $ _crPerception cr
         newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
         becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
-        maybeBark  | becomesCognizant = case vocalizationTest cr of
+        thejitter = do
-            Just sid -> crActionPlan . crImpulse .~ [Bark sid]
+            p <- randInCirc 1
-            Nothing -> id
+            return $ Move p
-                   | otherwise = id
+        maybeBark
+            | becomesCognizant = case vocalizationTest cr of
+                Just sid -> crActionPlan . crAction .~ 
+                    [ImpulsesList
+                        [[Bark sid]
+                        ,[RandomImpulse thejitter]
+                        ,[RandomImpulse thejitter]
+                        ,[RandomImpulse thejitter]
+                        ,[RandomImpulse thejitter]
+                        ,[RandomImpulse thejitter]
+                        ]
+                    ]
+                Nothing -> id
+            | otherwise = id
 
 chaseCritAwarenessUpdate :: World -> Creature -> Creature
 chaseCritAwarenessUpdate w cr = case _crAttentionDir $ _crPerception cr of
@@ -64,14 +77,21 @@ chaseCritAwarenessUpdate w cr = case _crAttentionDir $ _crPerception cr of
         newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
         becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
         randBool = takeOne [False,True] & evalState $ _randGen w
+        thejitter = do
+            p <- randInCirc 2
+            return $ Move p
         maybeBark  
             | becomesCognizant && randBool = case vocalizationTest cr of
                 Just soundid -> crActionPlan . crStrategy .~ StrategyActions WarningCry 
-                    [DoImpulses [Bark soundid]
+                    [ImpulsesList ([Bark soundid]: replicate 20 [RandomImpulse thejitter]++
-                        `DoActionThen` 20 
+                        [[ChangeStrategy $ CloseToMelee 0] ])
-                        `WaitThen` DoImpulses [ChangeStrategy $ CloseToMelee 0]
                     , AimAt 0 (_crPos $ _creatures w IM.! 0)
                     ]
+                    --[ImpulsesList [Bark soundid: replicate 20 (RandomImpulse thejitter)]
+                    --    `DoActionThen` 20 
+                    --    `WaitThen` DoImpulses [ChangeStrategy $ CloseToMelee 0]
+                    --, AimAt 0 (_crPos $ _creatures w IM.! 0)
+                    --]
                 Nothing -> id
             | otherwise = id
 

src/Dodge/Data.hs

@@ -911,6 +911,7 @@ data Impulse
     | MoveForward Float
     | Turn Float
     | RandomTurn Float
+    | RandomImpulse (State StdGen Impulse)
     | TurnToward Point2 Float
     | MvTurnToward Point2
     | MvForward
@@ -961,6 +962,7 @@ instance Show Impulse where
         ImpulseUseTargetCID {} -> "ImpulseUseTargetCID"
         ImpulseUseTarget {} -> "ImpulseUseTarget"
         ImpulseUseAheadPos {} -> "ImpulseUseAheadPos"
+        RandomImpulse {} -> "RandomImpulse"
 --  deriving (Eq,Ord,Show)
 infixr 9 `WaitThen`
 infixr 9 `DoActionThen`
@@ -968,7 +970,11 @@ infixr 9 `DoActionWhile`
 infixr 9 `DoReplicate`
 infixr 9 `DoImpulsesAlongside`
 data Action
-    = AimAt
+    = LabelAction
+        {_actLabel :: String
+        ,_actAction :: Action
+        }
+    | AimAt
         {_targetID      :: Int 
         ,_targetSeenAt  :: Point2 
         }
@@ -1060,6 +1066,10 @@ data Action
   deriving (Generic)
 instance Show Action where
     show act = case act of
+        LabelAction
+          {_actLabel = str
+          ,_actAction = subAct
+          } -> str++":"++show subAct
         AimAt
           {_targetID     = tid
           ,_targetSeenAt = p

src/Dodge/WallCreatureCollisions.hs

@@ -60,7 +60,6 @@ pushCreatureOutFromWalls ls cr = cr & crPos %~ pushOutFromWalls (_crRad cr) ls
 pushOutFromWalls :: Float -> [(Point2,Point2)] -> Point2 -> Point2
 pushOutFromWalls rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall rad p1)) wls of
     Nothing -> p1
-    --Just p2 -> fromMaybe p2 $ (getLast . foldMap (Last . pushOutFromWall rad p2)) wls
     Just p2 -> pushOutFromWalls rad (tail wls) p2
     -- possible improvement: choose between the closer of p2 and "p3" to p1