NPCs now have agent system/petri net

This commit is contained in:
nek0 2018-09-08 14:05:07 +02:00
parent d687eb9ae5
commit e6f95e9c42
6 changed files with 78 additions and 35 deletions

View file

@ -5,6 +5,8 @@ import qualified Data.Matrix as M
import qualified Data.Text as T
import Data.Maybe
import Linear (V2(..))
import Control.Monad (foldM)
import Control.Concurrent.MVar
@ -75,7 +77,7 @@ buildElevator
-> (StdGen, Matrix TileState)
-> (StdGen, Matrix TileState)
buildElevator fc (gen, empty) =
let (row, col) = fcElevator fc
let (V2 row col) = fcElevator fc
boxCoord x = (,) <$> [row - x .. row + x] <*> [col - x .. col + x]
buildShaft = foldl
(\acc coord -> M.setElem (replaceTile (acc M.! coord) Hall) coord acc)
@ -97,7 +99,7 @@ placeHalls rng fc input =
doHalls
:: StdGen
-> [Boundaries Int]
-> (Int , Int)
-> (V2 Int)
-> Int
-> Matrix TileState
-> (StdGen, Matrix TileState)
@ -114,7 +116,7 @@ placeHalls rng fc input =
if wmax - 1 >= 3 &&
all (\(Boundaries (minr, minc) (maxr, maxc)) ->
maxr - minr > 3 && maxc - minc > 3) nbs
then doHalls g2 nbs (row, col) (wmax -1) nmat
then doHalls g2 nbs (V2 row col) (wmax -1) nmat
else (g2, nmat)
) (rand, mat) bs
@ -123,12 +125,12 @@ boundSize (Boundaries mi ma) =
(fst ma - fst mi) * (snd ma - snd mi)
buildHall
:: (Int, Int)
:: (V2 Int)
-> Int
-> Boundaries Int
-> Matrix TileState
-> ([Boundaries Int], Matrix TileState)
buildHall coord@(row, col) width bs mat =
buildHall coord@(V2 row col) width bs mat =
let vertHalls = foldl (flip (M.mapCol
(\r cur -> if r >= fst (matmin bs) && r <= fst (matmax bs)
then replaceTile cur Hall
@ -143,10 +145,10 @@ buildHall coord@(row, col) width bs mat =
)))
vertHalls
[row - (width `div` 2) .. row + (width `div` 2)]
in ( [ Boundaries (matmin bs) coord
in ( [ Boundaries (matmin bs) (row, col)
, Boundaries (fst (matmin bs), col) (row, snd (matmax bs))
, Boundaries (row, snd (matmin bs)) (fst (matmax bs), col)
, Boundaries coord (matmax bs)
, Boundaries (row, col) (matmax bs)
]
, horzHalls
)
@ -317,9 +319,9 @@ buildFacilities gen fc input =
findNearestOffice
:: Matrix TileState
-> (V2 Int)
-> (Int, Int)
-> (Int, Int)
findNearestOffice mat (rrr, ccc) =
findNearestOffice mat (V2 rrr ccc) =
let matcoord = (,) <$> [1 .. nrows mat] <*> [1 .. ncols mat]
distance :: (Int, Int) -> Int
distance (ar, ac) = (ar - rrr) ^ (2 :: Int) + (ac - ccc) ^ (2 :: Int)

View file

@ -84,8 +84,8 @@ loadMapFork ud ad future progress = do
let loadSteps = 22
increment = 1 / loadSteps
fc = FloorConfig
(10, 10)
[] -- [(5, 5), (5, 20)]
(V2 10 10)
[(V2 5 5), (V2 5 20)]
(40, 40)
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
@ -108,7 +108,8 @@ loadMapFork ud ad future progress = do
( p + increment
, "Placing furniture"
)))
(inter, rps) <- placeInteriorIO mat imgmat exits gr
(inter, rawrps) <- placeInteriorIO mat imgmat exits gr
let rps = ReachPoint Elevator (fcElevator fc) SE : rawrps
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Creating WorldState"
@ -135,9 +136,9 @@ loadMapFork ud ad future progress = do
, "Registering computers into WorldState"
)))
let computers = Prelude.filter (\a -> pointType a == Computer) rps
compEnts <- mapM (\(ReachPoint _ icoord dir) -> do
mapM_ (\(ReachPoint _ icoord dir) -> do
let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
createEntity $ newEntity
void $ createEntity $ newEntity
{ pos = Just $ reachCoord - case dir of
N -> V2 1 (-1)
_ -> error "not yet defined"
@ -212,16 +213,11 @@ loadMapFork ud ad future progress = do
pos' <- query pos
bnds <- query obstacle
return (pos', bnds)
mapM_ (\(ce, npcpos@(V2 nr nc)) -> do
mapM_ (\(crp, npcpos@(V2 nr nc)) -> do
fact <- liftIO $ randomRIO (0.5, 1.5)
fut <- liftIO newEmptyMVar
[access] <- efor (anEnt ce) $ do
with pos
pos' <- query pos
acc <- queryMaybe objAccess
return $ fmap floor pos' + fromMaybe (V2 0 0) (fst <$> acc)
_ <- liftIO $ forkIO $
getPathTo (fmap floor npcpos) fut access inter posbounds
getPathTo (fmap floor npcpos) fut (pointCoord crp) inter posbounds
stats <- liftIO $ NPCStats
<$> (randomRIO (0, 1))
<*> (randomRIO (0, 1))
@ -230,16 +226,17 @@ loadMapFork ud ad future progress = do
<*> (randomRIO (0, 1))
<*> (randomRIO (0, 1))
void $ createEntity $ newEntity
{ pos = Just (fmap (+ 0.5) npcpos)
, vel = Just (V2 0 0)
, velFact = Just fact
, rot = Just SE
, npcMoveState = Just (NPCStanding 0 fut)
, npcWorkplace = Just ce
, npcStats = Just stats
, anim = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0
{ pos = Just (fmap (+ 0.5) npcpos)
, vel = Just (V2 0 0)
, velFact = Just fact
, rot = Just SE
, npcMoveState = Just (NPCStanding 0 fut)
, npcWorkplace = Just crp
, npcActionState = Just ASWork
, npcStats = Just stats
, anim = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0
}
) (zip compEnts npcposs)
) (zip computers npcposs)
liftIO $ modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Handing over"

View file

@ -83,6 +83,9 @@ updateNPCs imgmat rp dt = do
moent <- catMaybes <$> eover allEnts (do
with pos
with npcMoveState
with npcActionState
with npcWorkplace
with npcStats
with vel
with rot
with anim
@ -100,10 +103,26 @@ updateNPCs imgmat rp dt = do
})
else do
mpath <- liftIO $ tryTakeMVar future
as <- query npcActionState
stats <- query npcStats
let nstats = case as of
ASDrink -> stats
{ statThirst = 0
, statDrink = 1
}
ASEat -> stats
{ statHunger = 0
, statFood = 1
}
ASToilet -> stats
{ statBladder = 0
}
_ -> stats
case mpath of
Just path ->
return (Nothing, unchanged
{ npcMoveState = Set $ NPCWalking path
, npcStats = Set nstats
})
Nothing ->
return (Nothing, unchanged
@ -112,7 +131,7 @@ updateNPCs imgmat rp dt = do
NPCWalking path ->
if not (null path)
then do
let itarget = V2 0.5 0.5 + (fromIntegral <$> head path) :: V2 Double
let itarget = fmap (+ 0.5) (fromIntegral <$> head path) :: V2 Double
if distance pos' itarget < 0.1
then
return (Nothing, unchanged
@ -125,8 +144,28 @@ updateNPCs imgmat rp dt = do
else do
future <- liftIO $ newEmptyMVar
stat <- query anim
as <- query npcActionState
targetRPs <- case as of
ASWork -> (: []) <$> query npcWorkplace
ASToilet -> do
let seekRP = filter (\p -> pointType p == Toilet) rp
if null seekRP
then return $ filter (\p -> pointType p == Elevator) rp
else return seekRP
ASDrink -> do
let seekRP = filter (\p -> pointType p == Drink) rp
if null seekRP
then return $ filter (\p -> pointType p == Elevator) rp
else return seekRP
ASEat -> do
let seekRP = filter (\p -> pointType p == Eat) rp
if null seekRP
then return $ filter (\p -> pointType p == Elevator) rp
else return seekRP
ASRandWalk ->
return $ filter (\p -> pointType p /= RoomExit) rp
_ <- liftIO $ forkIO $
getPath (fmap floor pos') future rp imgmat posbounds
getPath (fmap floor pos') future targetRPs imgmat posbounds
e <- queryEnt
let mdir =
pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp

View file

@ -9,6 +9,7 @@ import Types.Map
import Types.NPCState
import Types.Animation
import Types.ObjType
import Types.ReachPoint
data Entity f = Entity
{ pos :: Component f 'Field (V2 Double)
@ -21,7 +22,7 @@ data Entity f = Entity
, obstacle :: Component f 'Field (Boundaries Double)
, player :: Component f 'Unique ()
, npcMoveState :: Component f 'Field NPCMoveState
, npcWorkplace :: Component f 'Field Ent
, npcWorkplace :: Component f 'Field ReachPoint
, npcActionState :: Component f 'Field NPCActionState
, npcStats :: Component f 'Field NPCStats
, anim :: Component f 'Field AnimState

View file

@ -1,6 +1,8 @@
{-# LANGUAGE FlexibleInstances #-}
module Types.Map where
import Linear (V2)
data TileState
= Wall
-- | Wind
@ -25,8 +27,8 @@ instance Show TileState where
show Unde = " "
data FloorConfig = FloorConfig
{ fcElevator :: (Int, Int)
, fcFacilities :: [(Int, Int)]
{ fcElevator :: V2 Int
, fcFacilities :: [V2 Int]
, fcSize :: (Int, Int)
} deriving (Show)

View file

@ -17,4 +17,6 @@ data PointType
| Computer
| Toilet
| Drink
| Eat
| Elevator
deriving (Eq, Show)