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 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
path <- liftIO $ getPath (fmap floor pos')
return $ defEntity'
{ npcState = Set $ NPCWalking path
}
mpath <- liftIO $ tryTakeMVar future
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
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'
Just p -> return p
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' 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.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)
liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show nnex
npcposs <- placeNPCs inter mat rps gr nnex
let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show (length 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

View file

@ -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
@ -160,7 +162,8 @@ data NPCState
{ npcWalkPath :: [V2 Int]
}
| NPCStanding
{ npcStandTime :: Double
{ npcStandTime :: Double
, npcFuturePath :: MVar [V2 Int]
}
data Subsystems = Subsystems