NPCs now have agent system/petri net

src/Floorplan.hs

@@ -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 (V2 rrr ccc) =
-findNearestOffice mat (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)

src/MainGame/WorldMap.hs

@@ -84,8 +84,8 @@ loadMapFork ud ad future progress = do
   let loadSteps = 22
       increment = 1 / loadSteps
       fc = FloorConfig
-        (10, 10)
+        (V2 10 10)
-        [] -- [(5, 5), (5, 20)]
+        [(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)
+        { pos            = Just (fmap (+ 0.5) npcpos)
-        , vel           = Just (V2 0 0)
+        , vel            = Just (V2 0 0)
-        , velFact       = Just fact
+        , velFact        = Just fact
-        , rot           = Just SE
+        , rot            = Just SE
-        , npcMoveState  = Just (NPCStanding 0 fut)
+        , npcMoveState   = Just (NPCStanding 0 fut)
-        , npcWorkplace  = Just ce
+        , npcWorkplace   = Just crp
-        , npcStats      = Just stats
+        , npcActionState = Just ASWork
-        , anim          = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0
+        , 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"

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

src/Types/Entity.hs

@@ -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

src/Types/Map.hs

@@ -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)
+  { fcElevator    :: V2 Int
-  , fcFacilities  :: [(Int, Int)]
+  , fcFacilities  :: [V2 Int]
   , fcSize        :: (Int, Int)
   } deriving (Show)
 

src/Types/ReachPoint.hs

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