nek0/tracer
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Merge branch 'npcperform'

Browse source
This commit is contained in:
nek0 2018-08-11 02:01:50 +02:00
commit f78b69b6f0
3 changed files with 122 additions and 123 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
src/MainGame/WorldMap.hs
View file

@ -102,7 +102,7 @@ loadMapFork ud ad future progress = do
_ <- liftIO $ swapMVar progress (13 / loadSteps, "Placing NPCs") _ <- liftIO $ swapMVar progress (13 / loadSteps, "Placing NPCs")
logIO A.Debug ("number of reachpoints: " ++ show (length rps)) logIO A.Debug ("number of reachpoints: " ++ show (length rps))
let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
npcposs <- placeNPCs inter mat rps 20 -- (length $ filter (\a -> pointType a == Table) nnex) npcposs <- placeNPCs inter mat rps 40 -- (length $ filter (\a -> pointType a == Table) nnex)
_ <- liftIO $ swapMVar progress (14 / loadSteps, "Preparing MindMap graph") _ <- liftIO $ swapMVar progress (14 / loadSteps, "Preparing MindMap graph")
A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs) A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs)
!(mmintmat, mmgraph) <- buildFloorMap . springField <$> !(mmintmat, mmgraph) <- buildFloorMap . springField <$>
@ -675,13 +675,6 @@ updateMap dt = do
} }
-- liftIO $ A.logIO A.Debug ("player position: " ++ show (pos' + colldpos)) -- liftIO $ A.logIO A.Debug ("player position: " ++ show (pos' + colldpos))
return ent return ent
updateNPCs
(imgMat $ stateData ud)
(Prelude.filter
(\p -> pointType p /= RoomExit)
(reachPoints $ stateData ud)
)
dt
tses <- efor allEnts $ do tses <- efor allEnts $ do
with objType with objType
with objState with objState
@ -692,8 +685,16 @@ updateMap dt = do
mapM_ (\(t, s, e) -> mapM_ (\(t, s, e) ->
objectAction dt t s e objectAction dt t s e
) tses ) tses
(nws2, _) <- yieldSystemT nws $ updateNPCs
(imgMat $ stateData ud)
(Prelude.filter
(\p -> pointType p /= RoomExit)
(reachPoints $ stateData ud)
)
dt
nws
putAffection ud putAffection ud
{ worldState = nws { worldState = nws2
} }
checkBoundsCollision2 checkBoundsCollision2

220
src/NPC.hs
View file

@ -6,9 +6,10 @@ import Affection as A
import qualified Data.Matrix as M import qualified Data.Matrix as M
import Data.Ecstasy as E import Data.Ecstasy as E
import Data.Maybe (fromMaybe) import Data.Maybe
import Data.List (find) import Data.List (find)
import Control.Monad.Trans
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Control.Concurrent.MVar import Control.Concurrent.MVar
import Control.Concurrent (forkIO) import Control.Concurrent (forkIO)
@ -61,18 +62,29 @@ updateNPCs
:: M.Matrix (Maybe ImgId) :: M.Matrix (Maybe ImgId)
-> [ReachPoint] -> [ReachPoint]
-> Double -> Double
-> SystemState Entity (AffectionState (AffectionData UserData) IO)
-> SystemT Entity (AffectionState (AffectionData UserData) IO) () -> SystemT Entity (AffectionState (AffectionData UserData) IO) ()
updateNPCs imgmat rp dt = do updateNPCs imgmat rp dt ws = do
posbounds <- efor allEnts $ do posbounds <- efor allEnts $ do
with pos with pos
with obstacle with obstacle
pos' <- query pos pos' <- query pos
bnds <- query obstacle bnds <- query obstacle
return (pos', bnds) return (pos', bnds)
npcs <- efor allEnts $ do npcposs <- efor allEnts $ do
with pos
with npcMoveState with npcMoveState
with vel with vel
with rot
with anim
pos' <- query pos
e <- queryEnt
return (e, pos')
eaccess <- getObjects npcposs
moent <- catMaybes <$> (eover allEnts $ do
with pos with pos
with npcMoveState
with vel
with rot with rot
with anim with anim
pos' <- query pos pos' <- query pos
@ -80,118 +92,99 @@ updateNPCs imgmat rp dt = do
let mdir = let mdir =
(pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp) (pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
e <- queryEnt e <- queryEnt
return (e, pos', rot', mdir) npcState' <- query npcMoveState
mapM_ (\(e, pos', rot', mdir) -> do case npcState' of
accessibles <- getObjects pos' NPCStanding ttl future -> do
moent <- eover (anEnt e) $ do let nttl = ttl - dt
npcState' <- query npcMoveState if nttl > 0
case npcState' of then
NPCStanding ttl future -> do return $ (Nothing, unchanged
let nttl = ttl - dt { npcMoveState = Set $ NPCStanding nttl future
if nttl > 0 , vel = Set $ V2 0 0
})
else do
mpath <- liftIO $ tryTakeMVar future
case mpath of
Just path ->
return $ (Nothing, unchanged
{ npcMoveState = Set $ NPCWalking path
})
Nothing ->
return $ (Nothing, unchanged
{ npcMoveState = Set $ NPCStanding 1 future
})
NPCWalking path -> do
pos' <- query pos
if not (null path)
then do
let itarget = V2 0.5 0.5 + (fromIntegral <$> head path) :: V2 Double
if distance pos' itarget < 0.1
then then
return $ (Nothing, unchanged return $ (Nothing, unchanged
{ npcMoveState = Set $ NPCStanding nttl future { npcMoveState = Set $ NPCWalking (tail path)
, vel = Set $ V2 0 0
}) })
else do else
mpath <- liftIO $ tryTakeMVar future return $ (Nothing, unchanged
case mpath of { vel = Set $ (* 2) <$> signorm (itarget - pos')
Just path -> })
return $ (Nothing, unchanged else do
{ npcMoveState = Set $ NPCWalking path future <- liftIO $ newEmptyMVar
}) stat <- query anim
Nothing -> _ <- liftIO $ forkIO $
return $ (Nothing, unchanged getPath (fmap floor pos') future rp imgmat posbounds
{ npcMoveState = Set $ NPCStanding 1 future e <- queryEnt
}) let mdir =
NPCWalking path -> do (pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
pos' <- query pos accessibles = fromMaybe [] $ lookup e eaccess
if not (null path) case accessibles of
then do [] -> do
let itarget = V2 0.5 0.5 + (fromIntegral <$> head path) :: V2 Double ttl <- liftIO $ randomRIO (5, 30)
if distance pos' itarget < 0.1
then
return $ (Nothing, unchanged return $ (Nothing, unchanged
{ npcMoveState = Set $ NPCWalking (tail path) { npcMoveState = Set $ NPCStanding ttl future
}) , vel = Set $ V2 0 0
else , rot = Set $ fromMaybe rot' mdir
return $ (Nothing, unchanged , anim = Set stat
{ vel = Set $ (* 2) <$> signorm (itarget - pos') { asId = (asId stat)
}) { aiDirection = fromMaybe rot' mdir
else do
future <- liftIO $ newEmptyMVar
stat <- query anim
rot' <- query rot
pos' <- query pos
_ <- liftIO $ forkIO $
getPath (fmap floor pos') future rp imgmat posbounds
let mdir =
(pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
-- ttl <- liftIO $ randomRIO (5, 30)
-- return $ (Nothing, unchanged
-- { npcMoveState = Set $ NPCStanding ttl future
-- , vel = Set $ V2 0 0
-- , rot = Set $ fromMaybe rot' mdir
-- , anim = Set stat
-- { asId = (asId stat)
-- { aiDirection = fromMaybe rot' mdir
-- }
-- }
-- })
case accessibles of
[] -> do
ttl <- liftIO $ randomRIO (5, 30)
return $ (Nothing, unchanged
{ npcMoveState = Set $ NPCStanding ttl future
, vel = Set $ V2 0 0
, rot = Set $ fromMaybe rot' mdir
, anim = Set stat
{ asId = (asId stat)
{ aiDirection = fromMaybe rot' mdir
}
} }
}) }
objects -> do })
liftIO $ logIO Debug ("applicable objects: " ++ show objects) objects -> do
rind <- liftIO $ randomRIO (0, length objects - 1) liftIO $ logIO Debug ("applicable objects: " ++ show objects)
npcent <- queryEnt rind <- liftIO $ randomRIO (0, length objects - 1)
let (oent, _, _) = objects !! rind npcent <- queryEnt
return (Just (oent, npcent), unchanged let (oent, _, _) = objects !! rind
{ rot = Set $ fromMaybe rot' mdir return (Just (oent, npcent, future), unchanged
, anim = Set stat { rot = Set $ fromMaybe rot' mdir
{ asId = (asId stat) , anim = Set stat
{ aiDirection = fromMaybe rot' mdir { asId = (asId stat)
} { aiDirection = fromMaybe rot' mdir
} }
}) }
mapM_ (\smoent -> maybe (return()) (\(oent, npcent) -> do , vel = Set $ V2 0 0
[(t, s)] <- efor (anEnt oent) $ do }))
with objType mapM_ (\(oent, npcent, future) -> do
with objState Just (t, s) <- runQueryT oent $ do
otyp <- query objType with objType
ostat <- query objState with objState
return (otyp, ostat) otyp <- query objType
setEntity oent =<< objectTransition t s False oent ostat <- query objState
[(nt, ns)] <- efor (anEnt oent) $ do return (otyp, ostat)
with objType setEntity oent =<< objectTransition t s False oent
with objState Just (nt, ns) <- runQueryT oent $ do
otyp <- query objType with objType
ostat <- query objState with objState
return (otyp, ostat) otyp <- query objType
emap (anEnt npcent) $ do ostat <- query objState
let ttl = actionTime nt ns return (otyp, ostat)
future <- liftIO $ newEmptyMVar emap (anEnt npcent) $ do
_ <- liftIO $ forkIO $ let ttl = actionTime nt ns
getPath (fmap floor pos') future rp imgmat posbounds return unchanged
return unchanged { npcMoveState = Set $ NPCStanding ttl future
{ npcMoveState = Set $ NPCStanding ttl future }
, vel = Set $ V2 0 0 ) moent
}
) smoent) moent
) npcs
getObjects npos = do getObjects npcposs = do
candidates <- efor allEnts $ do candidates <- efor allEnts $ do
with pos with pos
with objType with objType
@ -201,9 +194,14 @@ getObjects npos = do
oacc <- query objAccess oacc <- query objAccess
ent <- queryEnt ent <- queryEnt
return (ent, pos', oacc) return (ent, pos', oacc)
return $ filter (\(_, p, (delta, _)) -> mapM (\(e, pos) ->
fmap floor p + delta == fmap floor npos return
) candidates ( e
, filter (\(_, p, (delta, _)) ->
fmap floor p + delta == fmap floor pos
) candidates
)
) npcposs
getPath getPath
:: V2 Int :: V2 Int

4
src/Object.hs
View file

@ -3,7 +3,7 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
module Object where module Object where
import Affection import Affection as A
import Control.Monad (when) import Control.Monad (when)
@ -67,4 +67,4 @@ instance ObjectAction ObjType ObjState where
instance ActionTime ObjType ObjState where instance ActionTime ObjType ObjState where
actionTime ObjCopier "copying" = 5 actionTime ObjCopier "copying" = 5
actionTime o s = error (show o ++ ": " ++ s ++ ": has not time") actionTime o s = A.log Error (show o ++ ": " ++ s ++ ": has not time") 0