workplace defined

src/MainGame/WorldMap.hs

@@ -111,49 +111,9 @@ loadMapFork ud ad future progress = do
   (inter, rps) <- placeInteriorIO mat imgmat exits gr
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
-    , "Placing NPCs"
+    , "Creating WorldState"
     )))
-  logIO A.Debug ("number of reachpoints: " ++ show (length rps))
+  (nws, mmimgmat) <- evalStateT (runState (yieldSystemT (worldState ud) $ do
-  let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
-  npcposs <- placeNPCs inter mat rps 40 -- (length $ filter (\a -> pointType a == Table) nnex)
-  modifyMVar_ progress (return . (\(p, _) ->
-    ( p + increment
-    , "Preparing MindMap graph"
-    )))
-  A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs)
-  (mmintmat, mmgraph) <- buildFloorMap . springField <$>
-    buildMindMap (length npcposs) 2
-  modifyMVar_ progress (return . (\(p, _) ->
-    ( p + increment
-    , "Unfolding and Converting MindMap to images"
-    )))
-  let !mmimgmat = convertTileToImg $ manhattan mmgraph mmintmat
-  modifyMVar_ progress (return . (\(p, _) ->
-    ( p + increment
-    , "Creating WorldState and placing player"
-    )))
-  (nws, _) <- evalStateT (runState (yieldSystemT (worldState ud) $ do
-    let pmmpos = (+ 0.5) . (fromIntegral :: Int -> Double) . floor <$> mmPos
-          (fromJust $ find (\a -> mmId a == 0) (vertexList mmgraph))
-        delta = (0, 0) :
-          Prelude.filter (/= (0,0)) ((,) <$> [-1 .. 1] <*> [-1 .. 1]) :: [(Int, Int)]
-        mmmpos = Prelude.foldl (\acc (dr, dc) ->
-          let (V2 pmr pmc) = floor <$> pmmpos
-              seekpos = (pmr + fromIntegral dr, pmc + fromIntegral dc)
-          in  if isNothing (mmimgmat M.! seekpos) && mmintmat M.! seekpos == 0
-              && isNothing acc
-            then Just (pmmpos + (fromIntegral <$> V2 dr dc))
-            else acc
-          ) Nothing delta
-    void $ createEntity $ newEntity
-      { pos           = Just (V2 10.5 10.5)
-      , mmpos         = mmmpos
-      , vel           = Just (V2 0 0)
-      , mmvel         = Just (V2 0 0)
-      , player        = Just ()
-      , rot           = Just SE
-      , anim          = Just $ AnimState (AnimId "intruder" "standing" SE) 0 0
-      }
     liftIO $ modifyMVar_ progress (return . (\(p, _) ->
       ( p + increment
       , "Registering copiers into WorldState"
@@ -175,13 +135,12 @@ loadMapFork ud ad future progress = do
       , "Registering computers into WorldState"
       )))
     let computers = Prelude.filter (\a -> pointType a == Computer) rps
-    mapM_ (\(ReachPoint _ icoord dir) -> do
+    compEnts <- mapM (\(ReachPoint _ icoord dir) -> do
       let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
-      void $ createEntity $ newEntity
+      createEntity $ newEntity
         { pos       = Just $ reachCoord - case dir of
           N -> V2 1 (-1)
           _ -> error "not yet defined"
-        -- , obstacle  = Just $ Boundaries (10/36, 8/36) (28/36, 30/36)
         , anim      = Just $ AnimState (AnimId "computer" "off" N) 0 0
         , objAccess = Just (V2 1 (-1), dir)
         , objType   = Just ObjComputer
@@ -203,6 +162,46 @@ loadMapFork ud ad future progress = do
         , objType   = Just ObjToilet
         }
       ) (A.log A.Debug ("number of toilets: " ++ show (length toilets)) toilets)
+    liftIO $ modifyMVar_ progress (return . (\(p, _) ->
+      ( p + increment
+      , "Placing NPCs"
+      )))
+    liftIO $ logIO A.Debug ("number of reachpoints: " ++ show (length rps))
+    let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
+    npcposs <- liftIO $ placeNPCs inter mat rps (length computers)
+    liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs)
+    liftIO $ modifyMVar_ progress (return . (\(p, _) ->
+      ( p + increment
+      , "Preparing MindMap graph"
+      )))
+    (mmintmat, mmgraph) <- liftIO $ buildFloorMap . springField <$>
+      buildMindMap (length npcposs) 2
+    liftIO $ modifyMVar_ progress (return . (\(p, _) ->
+      ( p + increment
+      , "Unfolding and Converting MindMap to images"
+      )))
+    let !mmimgmat = convertTileToImg $ manhattan mmgraph mmintmat
+        pmmpos = (+ 0.5) . (fromIntegral :: Int -> Double) . floor <$> mmPos
+          (fromJust $ find (\a -> mmId a == 0) (vertexList mmgraph))
+        delta = (0, 0) :
+          Prelude.filter (/= (0,0)) ((,) <$> [-1 .. 1] <*> [-1 .. 1]) :: [(Int, Int)]
+        mmmpos = Prelude.foldl (\acc (dr, dc) ->
+          let (V2 pmr pmc) = floor <$> pmmpos
+              seekpos = (pmr + fromIntegral dr, pmc + fromIntegral dc)
+          in  if isNothing (mmimgmat M.! seekpos) && mmintmat M.! seekpos == 0
+              && isNothing acc
+            then Just (pmmpos + (fromIntegral <$> V2 dr dc))
+            else acc
+          ) Nothing delta
+    void $ createEntity $ newEntity
+      { pos           = Just (V2 10.5 10.5)
+      , mmpos         = mmmpos
+      , vel           = Just (V2 0 0)
+      , mmvel         = Just (V2 0 0)
+      , player        = Just ()
+      , rot           = Just SE
+      , anim          = Just $ AnimState (AnimId "intruder" "standing" SE) 0 0
+      }
     liftIO $ modifyMVar_ progress (return . (\(p, _) ->
       ( p + increment
       , "Registering NPCs into WorldState"
@@ -213,24 +212,31 @@ loadMapFork ud ad future progress = do
       pos' <- query pos
       bnds <- query obstacle
       return (pos', bnds)
-    mapM_ (\npcpos@(V2 nr nc) -> do
+    mapM_ (\(ce, 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 $
-        getPath (fmap floor npcpos) fut nnex inter posbounds
+        getPathTo (fmap floor npcpos) fut access inter posbounds
       void $ createEntity $ newEntity
-        { pos           = Just (V2 (nr + 0.5) (nc + 0.5))
+        { 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
         , anim          = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0
         }
-      ) npcposs
+      ) (zip compEnts npcposs)
     liftIO $ modifyMVar_ progress (return . (\(p, _) ->
       ( p + increment
       , "Handing over"
       )))
+    return mmimgmat
     )) ad
   putMVar future (nws, MainData
       { mapMat = mat

src/NPC.hs

@@ -216,3 +216,19 @@ getPath pos' mvar rp imgmat posbounds = do
   case path of
     Nothing -> getPath pos' mvar rp imgmat posbounds
     Just p  -> putMVar mvar p
+
+getPathTo
+  :: V2 Int
+  -> MVar [V2 Int]
+  -> V2 Int
+  -> M.Matrix (Maybe ImgId)
+  -> [(V2 Double, Boundaries Double)]
+  -> IO ()
+getPathTo pos' mvar target imgmat posbounds = do
+  let path = astarAppl imgmat posbounds target pos'
+  logIO A.Verbose ("seeking path from " ++ show pos' ++ " to " ++ show target)
+  case path of
+    Nothing -> do
+      logIO A.Error ("No path from " ++ show pos' ++ " to " ++ show target)
+      putMVar mvar [pos']
+    Just p  -> putMVar mvar p

src/Types/Entity.hs

@@ -21,6 +21,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
   , anim               :: Component f 'Field AnimState
   , objAccess          :: Component f 'Field ((V2 Int), Direction)
   , objType            :: Component f 'Field ObjType