fix and optimization

This commit is contained in:
nek0 2018-08-11 01:12:07 +02:00
parent 2911514578
commit 0e5486f048
2 changed files with 119 additions and 124 deletions

View file

@ -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

View file

@ -6,9 +6,10 @@ import Affection as A
import qualified Data.Matrix as M
import Data.Ecstasy as E
import Data.Maybe (fromMaybe, fromJust)
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,141 +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 <- runQueryT 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
}
})
(\(_, ent) ->
setEntity e ent
) (fromJust moent)
maybe (return()) (\(oent, npcent) -> 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)
Just npc <- runQueryT 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
}
setEntity npcent npc
) (fromJust (fst <$> 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
@ -205,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