starting agent system/petri net

This commit is contained in:
nek0 2018-09-07 23:39:53 +02:00
parent f10b5d7d52
commit d687eb9ae5
4 changed files with 67 additions and 0 deletions

View file

@ -222,6 +222,13 @@ loadMapFork ud ad future progress = do
return $ fmap floor pos' + fromMaybe (V2 0 0) (fst <$> acc) return $ fmap floor pos' + fromMaybe (V2 0 0) (fst <$> acc)
_ <- liftIO $ forkIO $ _ <- liftIO $ forkIO $
getPathTo (fmap floor npcpos) fut access inter posbounds 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 void $ createEntity $ newEntity
{ pos = Just (fmap (+ 0.5) npcpos) { pos = Just (fmap (+ 0.5) npcpos)
, vel = Just (V2 0 0) , vel = Just (V2 0 0)
@ -229,6 +236,7 @@ loadMapFork ud ad future progress = do
, rot = Just SE , rot = Just SE
, npcMoveState = Just (NPCStanding 0 fut) , npcMoveState = Just (NPCStanding 0 fut)
, npcWorkplace = Just ce , npcWorkplace = Just ce
, npcStats = Just stats
, anim = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0 , anim = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0
} }
) (zip compEnts npcposs) ) (zip compEnts npcposs)

View file

@ -63,6 +63,7 @@ updateNPCs
-> Double -> Double
-> SystemT Entity (AffectionState (AffectionData UserData) IO) () -> SystemT Entity (AffectionState (AffectionData UserData) IO) ()
updateNPCs imgmat rp dt = do updateNPCs imgmat rp dt = do
updateStats dt
posbounds <- efor allEnts $ do posbounds <- efor allEnts $ do
with pos with pos
with obstacle with obstacle
@ -177,6 +178,45 @@ updateNPCs imgmat rp dt = do
} }
) moent ) 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 getObjects
:: (Monad m, Traversable t, RealFrac a1) :: (Monad m, Traversable t, RealFrac a1)
=> t (a2, V2 a1) => t (a2, V2 a1)

View file

@ -22,6 +22,8 @@ data Entity f = Entity
, player :: Component f 'Unique () , player :: Component f 'Unique ()
, npcMoveState :: Component f 'Field NPCMoveState , npcMoveState :: Component f 'Field NPCMoveState
, npcWorkplace :: Component f 'Field Ent , npcWorkplace :: Component f 'Field Ent
, npcActionState :: Component f 'Field NPCActionState
, npcStats :: Component f 'Field NPCStats
, anim :: Component f 'Field AnimState , anim :: Component f 'Field AnimState
, objAccess :: Component f 'Field ((V2 Int), Direction) , objAccess :: Component f 'Field ((V2 Int), Direction)
, objType :: Component f 'Field ObjType , objType :: Component f 'Field ObjType

View file

@ -11,3 +11,20 @@ data NPCMoveState
{ npcStandTime :: Double { npcStandTime :: Double
, npcFuturePath :: MVar [V2 Int] , 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
}