From d687eb9ae5d45dd68ffdd36849cfd87d137a5e36 Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 7 Sep 2018 23:39:53 +0200 Subject: [PATCH] starting agent system/petri net --- src/MainGame/WorldMap.hs | 8 ++++++++ src/NPC.hs | 40 ++++++++++++++++++++++++++++++++++++++++ src/Types/Entity.hs | 2 ++ src/Types/NPCState.hs | 17 +++++++++++++++++ 4 files changed, 67 insertions(+) diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index 7ea4e2a..8756adf 100644 --- a/src/MainGame/WorldMap.hs +++ b/src/MainGame/WorldMap.hs @@ -222,6 +222,13 @@ loadMapFork ud ad future progress = do return $ fmap floor pos' + fromMaybe (V2 0 0) (fst <$> acc) _ <- liftIO $ forkIO $ getPathTo (fmap floor npcpos) fut access inter posbounds + stats <- liftIO $ NPCStats + <$> (randomRIO (0, 1)) + <*> (randomRIO (0, 1)) + <*> (randomRIO (0, 1)) + <*> (randomRIO (0, 1)) + <*> (randomRIO (0, 1)) + <*> (randomRIO (0, 1)) void $ createEntity $ newEntity { pos = Just (fmap (+ 0.5) npcpos) , vel = Just (V2 0 0) @@ -229,6 +236,7 @@ loadMapFork ud ad future progress = do , rot = Just SE , npcMoveState = Just (NPCStanding 0 fut) , npcWorkplace = Just ce + , npcStats = Just stats , anim = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0 } ) (zip compEnts npcposs) diff --git a/src/NPC.hs b/src/NPC.hs index e40087b..22f5b42 100644 --- a/src/NPC.hs +++ b/src/NPC.hs @@ -63,6 +63,7 @@ updateNPCs -> Double -> SystemT Entity (AffectionState (AffectionData UserData) IO) () updateNPCs imgmat rp dt = do + updateStats dt posbounds <- efor allEnts $ do with pos with obstacle @@ -177,6 +178,45 @@ updateNPCs imgmat rp dt = do } ) moent +updateStats + :: Double + -> SystemT Entity (AffectionState (AffectionData UserData) IO) () +updateStats dt = + emap allEnts $ do + with npcStats + with npcActionState + stat <- query npcStats + as <- query npcActionState + let nstat = doUpdate stat as + return unchanged + { npcStats = Set nstat + , npcActionState = Set $ doCompare stat nstat as + } + where + doUpdate stat@(NPCStats conc blad thir hung food drin) as = + stat + { statConcentration = + if as == ASWork + then max 0 (conc - 0.2 * dt) + else min 1 (conc + 0.075 * dt) + , statBladder = + if food > 0 || drin > 0 + then min 1 (blad + 0.3 * dt) + else blad + , statThirst = min 1 (if drin > 0 then thir else thir + 0.2 * dt) + , statHunger = min 1 (if food > 0 then hung else hung + 0.1 * dt) + , statFood = max 0 (food - 0.1 * dt) + , statDrink = max 0 (drin - 0.2 * dt) + } + doCompare ostat nstat as + | statConcentration nstat == 0 = ASRandWalk + | statThirst nstat == 0 = ASDrink + | statHunger nstat == 0 = ASDrink -- TODO: Let them eat + | statConcentration nstat > statConcentration ostat && + statConcentration nstat > 0.75 = ASWork + | statBladder nstat > 0.9 = ASToilet + | otherwise = as + getObjects :: (Monad m, Traversable t, RealFrac a1) => t (a2, V2 a1) diff --git a/src/Types/Entity.hs b/src/Types/Entity.hs index ee30c54..824e15b 100644 --- a/src/Types/Entity.hs +++ b/src/Types/Entity.hs @@ -22,6 +22,8 @@ data Entity f = Entity , player :: Component f 'Unique () , npcMoveState :: Component f 'Field NPCMoveState , npcWorkplace :: Component f 'Field Ent + , npcActionState :: Component f 'Field NPCActionState + , npcStats :: Component f 'Field NPCStats , anim :: Component f 'Field AnimState , objAccess :: Component f 'Field ((V2 Int), Direction) , objType :: Component f 'Field ObjType diff --git a/src/Types/NPCState.hs b/src/Types/NPCState.hs index a57d2a1..4c29473 100644 --- a/src/Types/NPCState.hs +++ b/src/Types/NPCState.hs @@ -11,3 +11,20 @@ data NPCMoveState { npcStandTime :: Double , npcFuturePath :: MVar [V2 Int] } + +data NPCActionState + = ASWork + | ASToilet + | ASDrink + | ASEat + | ASRandWalk + deriving (Eq) + +data NPCStats = NPCStats + { statConcentration :: Double + , statBladder :: Double + , statThirst :: Double + , statHunger :: Double + , statFood :: Double + , statDrink :: Double + }