starting agent system/petri net

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)

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)

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

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
+  }