fork pathseeking off into seperate thread

This commit is contained in:
nek0 2018-05-16 16:23:23 +02:00
parent 1f1bdd216a
commit b59b566905
3 changed files with 47 additions and 24 deletions

View file

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

View file

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

View file

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