NPCs now have agent system/petri net
This commit is contained in:
nek0
parent
d687eb9ae5
commit
e6f95e9c42
6 changed files with 78 additions and 35 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
43
src/NPC.hs
43
src/NPC.hs
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -17,4 +17,6 @@ data PointType
|
|||
| Computer
|
||||
| Toilet
|
||||
| Drink
|
||||
| Eat
|
||||
| Elevator
|
||||
deriving (Eq, Show)
|
||||
|
|
|
|||
Loading…
Reference in a new issue