Implement basic attention and awareness

src/Dodge/Creature.hs

@@ -9,6 +9,7 @@ import Dodge.Creature.Impulse.Data
 import Dodge.Creature.ImpulseRat
 import Dodge.Creature.ActionRat
 import Dodge.Creature.Rationality.Data
+import Dodge.Creature.AlertLevel
 import Dodge.Data
 import Dodge.AIs
 import Dodge.Default
@@ -94,7 +95,11 @@ armourChaseCrit = defaultCreature
 miniGunCrit' :: Creature
 miniGunCrit' = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate $ impulsiveAI $ actionUpdateAI $ shootAtTarget targetYouLOS
+    , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
+        [ actionUpdateAI performActions
+        , shootAtTarget targetYouCognizant 
+        , basicPerceptionUpdate [0]
+        ]
     , _crInv = IM.fromList [(0,miniGun)]
     , _crInvSel = 0
     , _crRad = 10
@@ -102,7 +107,7 @@ miniGunCrit' = defaultCreature
     , _crHP = 500
     , _crRationality = ActionRat 
         { _crImpulse = []
-        , _crAction  = [AimAtCloseSlow 0 (0,0) 0.05 0.2 (pi/4) ]
+        , _crAction  = [AimAtCloseSlow 0 (0,0) 0.2 0.01 (pi/4) ]
         }
     }
 miniGunCrit :: Creature
@@ -237,7 +242,7 @@ startCr = defaultCreature
     , _crUpdate = stateUpdate yourControl
     , _crRad = 10
     , _crMass = 10
-    , _crHP = 1000
+    , _crHP = 1000000000
     , _crMaxHP = 1500
     , _crInv = startInventory 
     , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10]

src/Dodge/Creature/Action.hs

@@ -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

src/Dodge/Creature/AlertLevel.hs

@@ -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)

src/Dodge/Creature/AlertLevel/Data.hs

@@ -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

src/Dodge/Creature/ChooseTarget.hs

@@ -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

src/Dodge/Creature/Picture.hs

@@ -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

src/Dodge/Creature/Rationality.hs

@@ -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

src/Dodge/Creature/State.hs

@@ -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   

src/Dodge/Creature/YourControl.hs

@@ -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)
+yourControl w (f,g) cr = 
-                         , Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 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
-
+{- | Turn key presses into creature movement.  -}
-{-
+wasdWithAiming 
-Turns key presses into creature movement.
+    :: World 
--}
+    -> Float    -- ^ Base speed
-wasdWithAiming :: World -> Float -> Int -> Creature -> Creature
+    -> Int      -- ^ Creature id
+    -> Creature 
+    -> Creature
 wasdWithAiming w speed i cr
-    | isAiming
+    | isAiming = set crDir mouseDir $ crMvBy (speed *.* mov) cr
-        = set crDir mouseDir 
+    | isMoving = crMvForward speed $ over crDir (`fromMaybe` dir) cr
-        $ crMvBy (speed *.* mov)
-          cr
-    | isMoving
-        = crMvForward speed -- controls the base speed
-        $ over crDir (`fromMaybe` dir) 
-          cr
     | otherwise = cr
   where 
     (mov',dir') = wasdComp (view keys w) w
@@ -56,15 +53,16 @@ wasdWithAiming w speed i cr
 
 wasdM :: World -> SDL.Scancode -> Point2
 wasdM w scancode 
- | scancode == moveUpKey (_keyConfig w) = (0,1)
+ | scancode == moveUpKey    (_keyConfig w) = ( 0, 1)
- | scancode == moveDownKey (_keyConfig w) = (0,-1)
+ | scancode == moveDownKey  (_keyConfig w) = ( 0,-1)
- | scancode == moveRightKey (_keyConfig w) = (1,0)
+ | scancode == moveRightKey (_keyConfig w) = ( 1, 0)
- | scancode == moveLeftKey (_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)
+  where
+    f (0,0) = ((0,0), Nothing)
     f p     = (errorNormalizeV 46 p, Just $ argV p)
 
 {- | Set posture according to mouse presses. -}
@@ -75,4 +73,3 @@ mouseActionsCr keys
   where 
     lbPressed = SDL.ButtonLeft  `S.member` keys
     rbPressed = SDL.ButtonRight `S.member` keys
-

src/Dodge/Data.hs

@@ -19,6 +19,7 @@ import Dodge.Creature.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.Rationality.Data
+import Dodge.Creature.AlertLevel.Data
 import Dodge.Data.Menu
 import Dodge.Data.SoundOrigin
 import Dodge.Data.DamageType
@@ -152,6 +153,9 @@ data Creature = Creature
     , _crStance         :: Stance
     , _crRationality    :: Rationality
     , _crMeleeCooldown  :: Maybe Int
+    , _crAwakeLevel     :: AwakeLevel
+    , _crAttentionDir   :: AttentionDir
+    , _crAwarenessLevel :: IM.IntMap AwarenessLevel
     }
 data WorldState 
     = DoorNumOpen Int 

src/Dodge/Default.hs

@@ -11,6 +11,7 @@ import Dodge.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.Rationality.Data
+import Dodge.Creature.AlertLevel.Data
 import Dodge.Data.Menu
 import Dodge.SoundLogic
 import Dodge.Base
@@ -92,6 +93,9 @@ defaultCreature = Creature
     , _crStance = Stance {_carriage=Walking 0 0,_posture=AtEase}
     , _crRationality = ImpulseRat []
     , _crMeleeCooldown = Nothing
+    , _crAwakeLevel = Vigilant
+    , _crAttentionDir = AttentiveTo []
+    , _crAwarenessLevel = IM.empty
     }
 defaultState = CrSt 
     { _goals = []

src/Dodge/Room.hs

@@ -199,20 +199,21 @@ roomMiniIntro :: RandomGen g => State g (Tree (Either Room Room))
 roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treeFromPost
     [return $ connectRoom door
     ,join $ takeOne [miniTree2,glassLesson]
---                  ,join $ takeOne [miniRoom1]
     ]
     $ fmap connectRoom $ randomiseOutLinks corridor
-    where f (Node (Right x) xs) = Node (Right (Right x)) $ map f xs
+  where 
+    f (Node (Right x) xs) = Node (Right (Right x)) $ map f xs
     f (Node (Left x) xs) = Node (Left (Left x)) $ map f xs
     g (Node (Right x) []) = Node (Right x) []
     g (Node (Right x) xs) = Node (Left x) $ map g xs
     g (Node y ys) = Node y $ map g ys
 
-
 roomCenterPillar :: RandomGen g => State g Room
 roomCenterPillar = changeLinkTo ((\p -> dist p (120,0) < 10) . fst) 
     $ set rmPS plmnts $ roomRect 240 240 2 2
-    where plmnts = [ blockLine (115,115) (115,125)
+  where 
+    plmnts = 
+        [ blockLine (115,115) (115,125)
         , blockLine (125,115) (125,125)
         , PS (40,120) 0 putLamp
         , PS (200,120) 0 putLamp
@@ -227,7 +228,9 @@ roomOctogon = Room
     , _rmPS    = []
     , _rmBound = [[(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ]
     }
-    where lnks = [((0,140),0)
+  where 
+    lnks = 
+        [((0,140),0)
         ,((35,125),0-pi/4)
         ,((-35,125),pi/4)
         ,( (50,90),0-pi/2)
@@ -236,6 +239,7 @@ roomOctogon = Room
         ,((-35,55),3*pi/4)
         ,( (0,40),pi)
         ]
+
 allPairs :: Eq a => [a] -> [(a,a)]
 allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]
 
@@ -243,10 +247,7 @@ randomCorridorFrom :: RandomGen g => [a] -> State g (Tree (Either a a))
 randomCorridorFrom xs = do
     rooms <- sequence $ replicate 5 $ takeOne xs
     return $ treeFromTrunk (map Left $ init rooms) (Node (Right (last rooms)) [])
-
+{- Probabilites of the type of the first floor weapon.  -}
-{-
-Probabilites of the type of the first floor weapon.
--}
 randFirstWeapon :: State StdGen PSType
 randFirstWeapon = do
     takeOne $ map PutFlIt $
@@ -256,15 +257,9 @@ randFirstWeapon = do
         ++ replicate 5 multGun
         ++ replicate 2 autoGun
         ++ [launcher]
---        ++ [lasGun]
---        ++ [flamer]
-
---randC1 :: State StdGen PSType
 
 randC = randC1
 
--- randSwarmCrit = RandPS $ takeOne $ map PutCrit $ (armouredSwarmCrit : replicate 100 swarmCrit)
-
 weaponEmptyRoom :: RandomGen g => State g (Tree (Either Room Room))
 weaponEmptyRoom = do
     w <- state $ randomR (220,300)
@@ -277,10 +272,10 @@ weaponEmptyRoom = do
     (fmap connectRoom . randomiseOutLinks) =<< (changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst) 
                         $ set rmPS plmnts $ roomRect w h 2 2)
      
-
 weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room))
 weaponUnderCrits = do
-      let plmnts = [PS (20,0)  0 $ RandPS randFirstWeapon
+    let plmnts = 
+            [PS (20,0)  0 $ RandPS randFirstWeapon
             ,PS (20,0) (0-pi/2) $ randC1
             ,PS (20,20) (0-pi/2) $ randC1
             ]
@@ -296,7 +291,6 @@ weaponUnderCrits = do
                               ,deadRoom deadEndRoom
                               ]
 
-
 weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room))
 weaponBehindPillar  = do
       crPos <- takeOne $ [(x,y) | x <- [20,220], y <- [20,220]] ++ [(120,160),(120,200)]
@@ -315,14 +309,16 @@ weaponBetweenPillars = do
     wpPos <- takeOne [(x,y) | x <- [20,120,220], y <- [20,120,220]]
     (ps,_) <- takeNMore 2 ([], [(x,y) | x <- [20,220], y <- [20,120,220]])
     let crPos1 = ps !! 0 
-      let crPos2 = ps !! 1
+        crPos2 = ps !! 1
-      let d p = argV $ (120,120) -.- p
+        d p = argV $ (120,120) -.- p
-      let plmnts = [PS wpPos 0 $ RandPS randFirstWeapon
+        plmnts = 
+            [PS wpPos 0 $ RandPS randFirstWeapon
             ,PS crPos1 (d crPos1) $ randC1
             ,PS crPos2 (d crPos2) $ randC1
             ]
     (fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars)
-    where f (_,a) = a == 0
+  where 
+    f (_,a) = a == 0
 
 weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
 weaponLongCorridor = do
@@ -355,21 +351,17 @@ deadEndRoom = Room
     , _rmPS    = [PS (0,-10) 0 putLamp]
     , _rmBound = [rectNSWE 20 (-20) (-30) 30]
     }
-    where lnks = [((0,30)  ,0)
+  where 
-                 ]
+    lnks = [((0,30)  ,0) ]
-
+{- A random Either tree with a weapon and melee monster challenge.  -}
-{-
-A random Either tree with a weapon and melee monster challenge.
--}
 weaponRoom :: RandomGen g => State g (Tree (Either Room Room))
-weaponRoom = do
+weaponRoom = join $ takeOne 
-    x <- takeOne [ weaponEmptyRoom
+    [ weaponEmptyRoom
     , weaponUnderCrits
     , weaponBehindPillar
     , weaponBetweenPillars
     , weaponLongCorridor
     ]
-    x
 
 roomCCrits :: RandomGen g => State g (Tree (Either Room Room))
 roomCCrits = do
@@ -397,10 +389,7 @@ longRoom = do
                     ]
     brls <- fmap (map (\p -> PS (p +.+ (10,200)) 0 $ PutCrit explosiveBarrel) )
                             $ sequence $ replicate 5 $ randInRect (w-20) 900
-    let rm = roomRect w (h+70) 1 1 & rmPolys %~ ( (++) 
+    let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
-                                                   [rectNSWE h (h-165) (-45) (w+45)
-                                                   ]
-                                                 )
     changeLinkTo cond $ set rmPS (ws ++ brls ++ wsDefense ++
                                  [PS ( 12.5,h-25) 0 $ PutCrit longCrit
                                  ,PS ( 37.5,h-25) 0 $ PutCrit longCrit