diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index faf33c73e..cdb01c45b 100644 --- a/src/Dodge/Creature/Action.hs +++ b/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)) diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index b7db09e20..aa34b1be0 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/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 diff --git a/src/Dodge/Creature/Perception.hs b/src/Dodge/Creature/Perception.hs index 77e57dc9e..3b643a6cc 100644 --- a/src/Dodge/Creature/Perception.hs +++ b/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 - Just sid -> crActionPlan . crImpulse .~ [Bark sid] - Nothing -> id - | otherwise = id + thejitter = do + p <- randInCirc 1 + return $ Move p + 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] - `DoActionThen` 20 - `WaitThen` DoImpulses [ChangeStrategy $ CloseToMelee 0] + [ImpulsesList ([Bark soundid]: replicate 20 [RandomImpulse thejitter]++ + [[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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index c76d59821..fa79ad285 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index 2c2fe083e..fe52c618a 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/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