fork pathseeking off into seperate thread

src/NPC.hs

@@ -6,6 +6,8 @@ import qualified Data.Matrix as M
 import Data.Ecstasy as E
 
 import Control.Monad.IO.Class (MonadIO(..))
+import Control.Concurrent.MVar
+import Control.Concurrent (forkIO)
 
 import Linear
 
@@ -115,20 +117,25 @@ updateNPCs imgmat rp dt =
     with pos
     npcState' <- E.get npcState
     case npcState' of
-      NPCStanding ttl -> do
+      NPCStanding ttl future -> do
         let nttl = ttl - dt
         if nttl > 0
         then
           return $ defEntity'
-            { npcState = Set $ NPCStanding nttl
+            { npcState = Set $ NPCStanding nttl future
             , vel      = Set $ V2 0 0
             }
         else do
-          pos' <- E.get pos
+          mpath <- liftIO $ tryTakeMVar future
-          path <- liftIO $ getPath (fmap floor pos')
+          case mpath of
+            Just path ->
               return $ defEntity'
                 { npcState = Set $ NPCWalking path
                 }
+            Nothing ->
+              return $ defEntity'
+                { npcState = Set $ NPCStanding 1 future
+                }
       NPCWalking path -> do
         pos' <- E.get pos
         if not (null path)
@@ -145,16 +152,25 @@ updateNPCs imgmat rp dt =
               }
         else do
           ttl <- liftIO $ randomRIO (5, 30)
+          future <- liftIO $ newEmptyMVar
+          _ <- liftIO $ forkIO $ getPath (fmap floor pos') future rp imgmat
           return $ defEntity'
-            { npcState = Set $ NPCStanding ttl
+            { npcState = Set $ NPCStanding ttl future
             }
-  where
+
-    getPath pos' = do
+
+getPath
+  :: V2 Int
+  -> MVar [V2 Int]
+  -> [ReachPoint]
+  -> M.Matrix (Maybe ImgId)
+  -> IO ()
+getPath pos' mvar rp imgmat = do
   let seekRP = filter (\p -> pointType p /= RoomExit) rp
   ntargeti <- randomRIO (0, length seekRP - 1)
   let ntarget = pointCoord (seekRP !! ntargeti)
       path = astarAppl imgmat ntarget pos'
   logIO A.Verbose ("seeking path from " ++ show pos' ++ " to " ++ show ntarget)
   case path of
-        Nothing -> getPath pos'
+    Nothing -> getPath pos' mvar rp imgmat
-        Just p  -> return p
+    Just p  -> putMVar mvar p

src/Test.hs

@@ -9,6 +9,8 @@ import NanoVG hiding (V2(..))
 
 import Control.Monad (when, unless, void)
 import Control.Monad.IO.Class (liftIO)
+import Control.Concurrent.MVar
+import Control.Concurrent (forkIO)
 
 import Data.Map.Strict as Map
 import qualified Data.Set as S
@@ -53,23 +55,25 @@ loadMap = do
   -- liftIO $ A.logIO A.Debug (show exits)
   (inter, rps) <- liftIO $ placeInteriorIO mat imgmat exits gr
   liftIO $ logIO A.Debug ("number of reachpoints: " ++ show (length rps))
-  let nnex = length (Prelude.filter (\p -> pointType p /= RoomExit) rps)
+  let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
-  liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show nnex
+  liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show (length nnex)
-  npcposs <- placeNPCs inter mat rps gr nnex
+  npcposs <- placeNPCs inter mat rps gr (length nnex)
   (nws, _) <- yieldSystemT (worldState ud) $ do
     void $ newEntity $ defEntity
       { pos = Just (V2 20.5 20.5)
       , vel = Just (V2 0 0)
       , player = Just ()
       }
-    void $ mapM_ (\(V2 nr nc) -> do
+    void $ mapM_ (\npcpos@(V2 nr nc) -> do
       -- ttl <- liftIO $ randomRIO (5, 30)
       fact <- liftIO $ randomRIO (0.5, 1.5)
+      future <- liftIO $ newEmptyMVar
+      _ <- liftIO $ forkIO $ getPath (fmap floor npcpos) future nnex inter
       newEntity $ defEntity
         { pos      = Just (V2 (nr + 0.5) (nc + 0.5))
         , vel      = Just (V2 0 0)
         , velFact = Just fact
-        , npcState = Just (NPCStanding 0)
+        , npcState = Just (NPCStanding 0 future)
         }
       ) npcposs
   uu <- partSubscribe m movePlayer

src/Types/UserData.hs

@@ -14,6 +14,8 @@ import qualified Data.Text as T
 import Data.Matrix
 import Data.Ecstasy
 
+import Control.Concurrent.MVar
+
 import Types.Map
 import Types.ReachPoint
 
@@ -161,6 +163,7 @@ data NPCState
     }
   | NPCStanding
     { npcStandTime  :: Double
+    , npcFuturePath :: MVar [V2 Int]
     }
 
 data Subsystems = Subsystems