Merge branch 'npcperform'
This commit is contained in:
nek0
commit
f78b69b6f0
3 changed files with 122 additions and 123 deletions
|
|
@ -102,7 +102,7 @@ loadMapFork ud ad future progress = do
|
|||
_ <- liftIO $ swapMVar progress (13 / loadSteps, "Placing NPCs")
|
||||
logIO A.Debug ("number of reachpoints: " ++ show (length 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")
|
||||
A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs)
|
||||
!(mmintmat, mmgraph) <- buildFloorMap . springField <$>
|
||||
|
|
@ -675,13 +675,6 @@ updateMap dt = do
|
|||
}
|
||||
-- liftIO $ A.logIO A.Debug ("player position: " ++ show (pos' + colldpos))
|
||||
return ent
|
||||
updateNPCs
|
||||
(imgMat $ stateData ud)
|
||||
(Prelude.filter
|
||||
(\p -> pointType p /= RoomExit)
|
||||
(reachPoints $ stateData ud)
|
||||
)
|
||||
dt
|
||||
tses <- efor allEnts $ do
|
||||
with objType
|
||||
with objState
|
||||
|
|
@ -692,8 +685,16 @@ updateMap dt = do
|
|||
mapM_ (\(t, s, e) ->
|
||||
objectAction dt t s e
|
||||
) tses
|
||||
(nws2, _) <- yieldSystemT nws $ updateNPCs
|
||||
(imgMat $ stateData ud)
|
||||
(Prelude.filter
|
||||
(\p -> pointType p /= RoomExit)
|
||||
(reachPoints $ stateData ud)
|
||||
)
|
||||
dt
|
||||
nws
|
||||
putAffection ud
|
||||
{ worldState = nws
|
||||
{ worldState = nws2
|
||||
}
|
||||
|
||||
checkBoundsCollision2
|
||||
|
|
|
|||
222
src/NPC.hs
222
src/NPC.hs
|
|
@ -6,9 +6,10 @@ import Affection as A
|
|||
|
||||
import qualified Data.Matrix as M
|
||||
import Data.Ecstasy as E
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Maybe
|
||||
import Data.List (find)
|
||||
|
||||
import Control.Monad.Trans
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Control.Concurrent.MVar
|
||||
import Control.Concurrent (forkIO)
|
||||
|
|
@ -61,137 +62,129 @@ updateNPCs
|
|||
:: M.Matrix (Maybe ImgId)
|
||||
-> [ReachPoint]
|
||||
-> Double
|
||||
-> SystemState 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
|
||||
with pos
|
||||
with obstacle
|
||||
pos' <- query pos
|
||||
bnds <- query obstacle
|
||||
return (pos', bnds)
|
||||
npcs <- efor allEnts $ do
|
||||
npcposs <- efor allEnts $ do
|
||||
with pos
|
||||
with npcMoveState
|
||||
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 npcMoveState
|
||||
with vel
|
||||
with rot
|
||||
with anim
|
||||
pos' <- query pos
|
||||
rot' <- query rot
|
||||
let mdir =
|
||||
let mdir =
|
||||
(pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
|
||||
e <- queryEnt
|
||||
return (e, pos', rot', mdir)
|
||||
mapM_ (\(e, pos', rot', mdir) -> do
|
||||
accessibles <- getObjects pos'
|
||||
moent <- eover (anEnt e) $ do
|
||||
npcState' <- query npcMoveState
|
||||
case npcState' of
|
||||
NPCStanding ttl future -> do
|
||||
let nttl = ttl - dt
|
||||
if nttl > 0
|
||||
npcState' <- query npcMoveState
|
||||
case npcState' of
|
||||
NPCStanding ttl future -> do
|
||||
let nttl = ttl - dt
|
||||
if nttl > 0
|
||||
then
|
||||
return $ (Nothing, unchanged
|
||||
{ npcMoveState = Set $ NPCStanding nttl future
|
||||
, 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
|
||||
return $ (Nothing, unchanged
|
||||
{ npcMoveState = Set $ NPCStanding nttl future
|
||||
, vel = Set $ V2 0 0
|
||||
{ npcMoveState = Set $ NPCWalking (tail path)
|
||||
})
|
||||
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
|
||||
else
|
||||
return $ (Nothing, unchanged
|
||||
{ vel = Set $ (* 2) <$> signorm (itarget - pos')
|
||||
})
|
||||
else do
|
||||
future <- liftIO $ newEmptyMVar
|
||||
stat <- query anim
|
||||
_ <- liftIO $ forkIO $
|
||||
getPath (fmap floor pos') future rp imgmat posbounds
|
||||
e <- queryEnt
|
||||
let mdir =
|
||||
(pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
|
||||
accessibles = fromMaybe [] $ lookup e eaccess
|
||||
case accessibles of
|
||||
[] -> do
|
||||
ttl <- liftIO $ randomRIO (5, 30)
|
||||
return $ (Nothing, unchanged
|
||||
{ npcMoveState = Set $ NPCWalking (tail path)
|
||||
})
|
||||
else
|
||||
return $ (Nothing, unchanged
|
||||
{ vel = Set $ (* 2) <$> signorm (itarget - pos')
|
||||
})
|
||||
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
|
||||
}
|
||||
{ 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)
|
||||
rind <- liftIO $ randomRIO (0, length objects - 1)
|
||||
npcent <- queryEnt
|
||||
let (oent, _, _) = objects !! rind
|
||||
return (Just (oent, npcent), unchanged
|
||||
{ rot = Set $ fromMaybe rot' mdir
|
||||
, anim = Set stat
|
||||
{ asId = (asId stat)
|
||||
{ aiDirection = fromMaybe rot' mdir
|
||||
}
|
||||
}
|
||||
})
|
||||
objects -> do
|
||||
liftIO $ logIO Debug ("applicable objects: " ++ show objects)
|
||||
rind <- liftIO $ randomRIO (0, length objects - 1)
|
||||
npcent <- queryEnt
|
||||
let (oent, _, _) = objects !! rind
|
||||
return (Just (oent, npcent, future), unchanged
|
||||
{ rot = Set $ fromMaybe rot' mdir
|
||||
, anim = Set stat
|
||||
{ asId = (asId stat)
|
||||
{ aiDirection = fromMaybe rot' mdir
|
||||
}
|
||||
})
|
||||
mapM_ (\smoent -> maybe (return()) (\(oent, npcent) -> do
|
||||
[(t, s)] <- efor (anEnt oent) $ do
|
||||
with objType
|
||||
with objState
|
||||
otyp <- query objType
|
||||
ostat <- query objState
|
||||
return (otyp, ostat)
|
||||
setEntity oent =<< objectTransition t s False oent
|
||||
[(nt, ns)] <- efor (anEnt oent) $ do
|
||||
with objType
|
||||
with objState
|
||||
otyp <- query objType
|
||||
ostat <- query objState
|
||||
return (otyp, ostat)
|
||||
emap (anEnt npcent) $ do
|
||||
let ttl = actionTime nt ns
|
||||
future <- liftIO $ newEmptyMVar
|
||||
_ <- liftIO $ forkIO $
|
||||
getPath (fmap floor pos') future rp imgmat posbounds
|
||||
return unchanged
|
||||
{ npcMoveState = Set $ NPCStanding ttl future
|
||||
, vel = Set $ V2 0 0
|
||||
}
|
||||
) smoent) moent
|
||||
) npcs
|
||||
}
|
||||
, vel = Set $ V2 0 0
|
||||
}))
|
||||
mapM_ (\(oent, npcent, future) -> do
|
||||
Just (t, s) <- runQueryT oent $ do
|
||||
with objType
|
||||
with objState
|
||||
otyp <- query objType
|
||||
ostat <- query objState
|
||||
return (otyp, ostat)
|
||||
setEntity oent =<< objectTransition t s False oent
|
||||
Just (nt, ns) <- runQueryT oent $ do
|
||||
with objType
|
||||
with objState
|
||||
otyp <- query objType
|
||||
ostat <- query objState
|
||||
return (otyp, ostat)
|
||||
emap (anEnt npcent) $ do
|
||||
let ttl = actionTime nt ns
|
||||
return unchanged
|
||||
{ npcMoveState = Set $ NPCStanding ttl future
|
||||
}
|
||||
) moent
|
||||
|
||||
getObjects npos = do
|
||||
getObjects npcposs = do
|
||||
candidates <- efor allEnts $ do
|
||||
with pos
|
||||
with objType
|
||||
|
|
@ -201,9 +194,14 @@ getObjects npos = do
|
|||
oacc <- query objAccess
|
||||
ent <- queryEnt
|
||||
return (ent, pos', oacc)
|
||||
return $ filter (\(_, p, (delta, _)) ->
|
||||
fmap floor p + delta == fmap floor npos
|
||||
) candidates
|
||||
mapM (\(e, pos) ->
|
||||
return
|
||||
( e
|
||||
, filter (\(_, p, (delta, _)) ->
|
||||
fmap floor p + delta == fmap floor pos
|
||||
) candidates
|
||||
)
|
||||
) npcposs
|
||||
|
||||
getPath
|
||||
:: V2 Int
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
{-# LANGUAGE FlexibleInstances #-}
|
||||
module Object where
|
||||
|
||||
import Affection
|
||||
import Affection as A
|
||||
|
||||
import Control.Monad (when)
|
||||
|
||||
|
|
@ -67,4 +67,4 @@ instance ObjectAction ObjType ObjState where
|
|||
instance ActionTime ObjType ObjState where
|
||||
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
|
||||
|
|
|
|||
Loading…
Reference in a new issue