Implement basic attention and awareness

2021-05-08 17:34:25 +02:00
parent 1aa59cc205
commit 86faf9fd01
12 changed files with 243 additions and 135 deletions
@@ -220,7 +220,7 @@ reloadWeapon cid w =
 crAutoReload :: Creature -> Creature
 crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
    Just 0 -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT)
-                 & crInv . ix (_crInvSel cr) . wpLoadedAmmo  %~ (`fromMaybe` maxA)
+        & crInv . ix (_crInvSel cr) . wpLoadedAmmo  %~ (`fromMaybe` maxA)
    _      -> cr
  where 
    reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime
@@ -360,7 +360,7 @@ creatureTurnToward p turnSpeed cr
    | vToTarg == (0,0) = cr -- this should deal with the angleVV error
    | errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
                                        = cr & crDir .~ dirToTarget
-    | isLeftOfA dirToTarget (_crDir cr) = cr & crDir +~ turnSpeed
+    | isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr) = cr & crDir +~ turnSpeed
    | otherwise                         = cr & crDir -~ turnSpeed
  where
    vToTarg = p -.- _crPos cr
@@ -0,0 +1,57 @@
+{- | Deals with changes in a creature's awareness of other creatures. -}
+module Dodge.Creature.AlertLevel
+    where
+import Dodge.Data
+import Dodge.Creature.AlertLevel.Data
+import Dodge.Base.Collide
+
+import Control.Lens
+import qualified Data.IntMap.Strict as IM
+
+{- | Ties together (currently) an awareness and attention update -}
+basicPerceptionUpdate
+    :: [Int]    -- ^ List of creature ids that may direct attention and awareness
+    -> World
+    -> Creature
+    -> Creature
+basicPerceptionUpdate is w cr 
+    = basicAwarenessUpdate w $ 
+        basicAttentionUpdate is w cr
+{- | Update a creatures awareness based upon the creatures current direction
+ of attention -}
+basicAwarenessUpdate 
+    :: World -> Creature -> Creature
+basicAwarenessUpdate w cr = case _crAttentionDir cr of
+    AttentiveTo is -> cr & crAwarenessLevel %~ updateAwareness is
+    Fixated i -> cr & crAwarenessLevel 
+        %~ ( IM.insert i (Cognizant 100) . IM.mapMaybe decreaseAwareness)
+{- | Increase awareness of a given list of ids -}
+updateAwareness :: [Int] -> IM.IntMap AwarenessLevel -> IM.IntMap AwarenessLevel
+updateAwareness is imawareness 
+    = foldr (\k -> IM.insertWith (\_ x -> increaseAwareness x) k (AwarenessInt 1))
+    (IM.mapMaybe decreaseAwareness imawareness) is
+    -- (IM.mapMaybe decreaseAwareness imawareness) is
+{- | Increase awareness level -}
+increaseAwareness :: AwarenessLevel -> AwarenessLevel
+increaseAwareness (AwarenessInt x)
+    | x < 100 = AwarenessInt $ x + 2
+    | otherwise = Cognizant 1
+increaseAwareness (Cognizant x)
+    | x < 100 = Cognizant (x + 2)
+    | otherwise = Cognizant 100
+{- | Decrease awareness level. Returns 'Maybe' value for use with 'IM.mapMaybe'
+ -}
+decreaseAwareness :: AwarenessLevel -> Maybe AwarenessLevel
+decreaseAwareness (AwarenessInt 0) = Nothing
+decreaseAwareness (AwarenessInt x) = Just $ AwarenessInt (x - 1)
+decreaseAwareness (Cognizant 0) = Just $ AwarenessInt 100
+decreaseAwareness (Cognizant x) = Just $ Cognizant $ x - 1
+{- | Given a fixed group of creatures, direct attention to those of them that
+ - are in view. -}
+basicAttentionUpdate
+    :: [Int] -- ^ Creatures that may attract this creature's attention
+    -> World
+    -> Creature
+    -> Creature
+basicAttentionUpdate cids w cr = cr & crAttentionDir .~
+    AttentiveTo (filter (\cid -> canSee (_crID cr) cid w) cids)
@@ -0,0 +1,17 @@
+module Dodge.Creature.AlertLevel.Data
+    where
+
+data AwakeLevel
+    = Comatose
+    | Asleep
+    | Lethargic
+    | Vigilant
+    | Overstrung
+
+data AttentionDir
+    = AttentiveTo [Int]
+    | Fixated  Int
+
+data AwarenessLevel
+    = AwarenessInt Int
+    | Cognizant Int
@@ -2,8 +2,22 @@ module Dodge.Creature.ChooseTarget
    where
 import Dodge.Data
 import Dodge.Base
+import Dodge.Creature.AlertLevel.Data
+
+import Control.Lens
+import qualified Data.IntMap.Strict as IM

 targetYouLOS :: Creature -> World -> Maybe Creature
 targetYouLOS cr w 
    | hasLOS (_crPos cr) (_crPos $ you w) w = Just $ you w
    | otherwise = Nothing
+
+targetYouCognizant :: Creature -> World -> Maybe Creature
+targetYouCognizant cr w 
+    | hasLOS (_crPos cr) (_crPos $ you w) w
+        && isCog (cr ^? crAwarenessLevel . ix 0) = Just $ you w
+    | otherwise = Nothing
+  where
+    isCog x = case x of
+        Just (Cognizant _) -> True
+        _ -> False
@@ -7,6 +7,7 @@ module Dodge.Creature.Picture
    ) where
 import Dodge.Data
 import Dodge.Creature.State.Data
+import Dodge.Creature.AlertLevel.Data
 import Dodge.Picture.Layer
 import Picture
 import Geometry
@@ -18,7 +19,11 @@ basicCrPict
    :: Color    -- ^ Creature color
    -> Creature 
    -> Picture
-basicCrPict col cr = pictures [ onLayer CrLayer . piercingMod $ bluntScale naked , drawEquipment cr]
+basicCrPict col cr = pictures 
+    [ onLayer CrLayer . piercingMod $ bluntScale naked 
+    , drawAwakeLevel cr
+    , drawEquipment cr
+    ]
  where 
    cdir = _crDir cr
    naked 
@@ -46,6 +51,15 @@ basicCrPict col cr = pictures [ onLayer CrLayer . piercingMod $ bluntScale naked
        Nothing -> False
        Just x  -> x > 5

+drawAwakeLevel
+    :: Creature
+    -> Picture
+drawAwakeLevel cr = case cr ^? crAttentionDir of
+    Just (AttentiveTo [0]) -> setPos . color red $ circleSolid 5
+    _        -> setPos . color blue $ circleSolid 5
+  where
+    setPos = translate 0 (_crRad cr)
+
 drawEquipment 
    :: Creature 
    -> Picture
@@ -14,6 +14,13 @@ import qualified Data.IntMap.Strict as IM
 import System.Random
 import Control.Lens

+composeInternalAIs 
+    :: [World -> Creature -> Creature]
+    -> World
+    -> Creature
+    -> Creature
+composeInternalAIs fs w c = foldr ($ w) c fs
+
 impulsiveAI 
    :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses
    -> World 
@@ -46,7 +53,7 @@ followImpulse imp w cr = case imp of
    MoveForward x  -> (id, crMvForward x cr)
    Turn a  -> (id, creatureTurn a cr)
    TurnToward p a -> (id, creatureTurnToward p a cr)
-    UseItem -> (crUseItem cr, cr)
+--    UseItem -> (crUseItem cr, cr)
    SwitchToItem i -> (id, cr & crInvSel .~ i)
    Melee crID -> 
        (hitCr crID
@@ -88,11 +95,11 @@ performAction cr w ac = case ac of
        Just x | x > 0  -> ( [UseItem] , Just ShootTillEmpty )
        _               -> ( []        , Nothing )
    AimAtCloseSlow tcid p speed slowSpeed a
-        | canSee (_crID cr) tcid w && abs (normalizeAngle $ cdir - argV (tpos -.- cpos)) < a 
+        | canSee (_crID cr) tcid w && safeAngleVV (unitVectorAtAngle cdir) (tpos -.- cpos) < a 
            -> ([TurnToward tpos slowSpeed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
        | canSee (_crID cr) tcid w
            -> ([TurnToward tpos speed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
-        | abs (normalizeAngle (cdir - (argV (p -.- cpos)))) < a
+        | safeAngleVV (unitVectorAtAngle cdir) (tpos -.- cpos) < a 
            -> ([TurnToward p slowSpeed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
        | otherwise -> ([TurnToward p speed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
      where
@@ -48,7 +48,7 @@ stateUpdate u w (f,g) cr =
    in case u w (f,g'') cr' of
        ((f',g') , maybeCr) -> ( (invSideEff cr . movementSideEff cr . deathEff . f'
                                 , g')
-                               , fmap (updateReloadCounter . doDamage) 
+                               , fmap (updateReloadCounter . doDamage . crAutoReload) 
                                      $ crOrCorpse =<< maybeCr
                               )
  where   
@@ -17,28 +17,25 @@ import Data.Maybe
 import qualified Data.Set as S
 import qualified Data.IntMap.Strict as IM
 import System.Random
-
+{- | The AI equivalent for your control. -}
 yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
-yourControl w (f,g) cr = ( (updateUsingInput . f, g)
-                         , Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr
-                         )
+yourControl w (f,g) cr = 
+    ( (updateUsingInput . f, g)
+    , Just . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr
+    )
  where 
    speed = _varMovementSpeedModifier w * equipFactor
    equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0
-
-{-
-Turns key presses into creature movement.
-}
-wasdWithAiming :: World -> Float -> Int -> Creature -> Creature
+{- | Turn key presses into creature movement.  -}
+wasdWithAiming 
+    :: World 
+    -> Float    -- ^ Base speed
+    -> Int      -- ^ Creature id
+    -> Creature 
+    -> Creature
 wasdWithAiming w speed i cr
-    | isAiming
-        = set crDir mouseDir 
-        $ crMvBy (speed *.* mov)
-          cr
-    | isMoving
-        = crMvForward speed -- controls the base speed
-        $ over crDir (`fromMaybe` dir) 
-          cr
+    | isAiming = set crDir mouseDir $ crMvBy (speed *.* mov) cr
+    | isMoving = crMvForward speed $ over crDir (`fromMaybe` dir) cr
    | otherwise = cr
  where 
    (mov',dir') = wasdComp (view keys w) w
@@ -56,16 +53,17 @@ wasdWithAiming w speed i cr

 wasdM :: World -> SDL.Scancode -> Point2
 wasdM w scancode 
- | scancode == moveUpKey (_keyConfig w) = (0,1)
- | scancode == moveDownKey (_keyConfig w) = (0,-1)
- | scancode == moveRightKey (_keyConfig w) = (1,0)
- | scancode == moveLeftKey (_keyConfig w) = (-1,0)
-wasdM _ _          = (0,0)
+ | scancode == moveUpKey    (_keyConfig w) = ( 0, 1)
+ | scancode == moveDownKey  (_keyConfig w) = ( 0,-1)
+ | scancode == moveRightKey (_keyConfig w) = ( 1, 0)
+ | scancode == moveLeftKey  (_keyConfig w) = (-1, 0)
+wasdM _ _ = (0,0)

 wasdComp :: S.Set SDL.Scancode -> World -> (Point2,Maybe Float)
 wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (0,0) ks
-    where f (0,0) = ((0,0), Nothing)
-          f p     = (errorNormalizeV 46 p, Just $ argV p)
+  where
+    f (0,0) = ((0,0), Nothing)
+    f p     = (errorNormalizeV 46 p, Just $ argV p)

 {- | Set posture according to mouse presses. -}
 mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
@@ -75,4 +73,3 @@ mouseActionsCr keys
  where 
    lbPressed = SDL.ButtonLeft  `S.member` keys
    rbPressed = SDL.ButtonRight `S.member` keys
-