take obstacles from ECS into account

This commit is contained in:
nek0 2018-07-21 21:10:32 +02:00
parent 81d6fd1180
commit f64aae86f0
5 changed files with 49 additions and 17 deletions

View file

@ -118,7 +118,7 @@ placeInteriorIO imat imgmat irp graph =
pc (pc + ncols cmat - 1)
mat
))) ||
not (isReachable newmat (oldreaches ++ reaches) exits)
not (isReachable newmat [] (oldreaches ++ reaches) exits)
then placeCluster g2 bnds (try + 1) mat rp appl
else placeCluster
g2 bnds (try + 1) newmat newrp appl

View file

@ -138,10 +138,17 @@ loadMapFork ud future progress = do
}
) (A.log A.Debug ("number of copiers: " ++ show (length copiers)) copiers)
void $ liftIO $ swapMVar progress (18 / loadSteps, "Registering NPCs into WorldState")
posbounds <- efor allEnts $ do
with pos
with obstacle
pos' <- query pos
bnds <- query obstacle
return (pos', bnds)
mapM_ (\npcpos@(V2 nr nc) -> do
fact <- liftIO $ randomRIO (0.5, 1.5)
fut <- liftIO newEmptyMVar
_ <- liftIO $ forkIO $ getPath (fmap floor npcpos) fut nnex inter
_ <- liftIO $ forkIO $
getPath (fmap floor npcpos) fut nnex inter posbounds
void $ createEntity $ newEntity
{ pos = Just (V2 (nr + 0.5) (nc + 0.5))
, vel = Just (V2 0 0)

View file

@ -59,7 +59,13 @@ updateNPCs
-> [ReachPoint]
-> Double
-> SystemT Entity m ()
updateNPCs imgmat rp dt =
updateNPCs imgmat rp dt = do
posbounds <- efor allEnts $ do
with pos
with obstacle
pos' <- query pos
bnds <- query obstacle
return (pos', bnds)
emap allEnts $ do
with npcMoveState
with vel
@ -109,7 +115,8 @@ updateNPCs imgmat rp dt =
let mdir =
(pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
-- _ <- liftIO $ forkOS $ getPath (fmap floor pos') future rp imgmat
_ <- liftIO $ forkIO $ getPath (fmap floor pos') future rp imgmat
_ <- liftIO $ forkIO $
getPath (fmap floor pos') future rp imgmat posbounds
return $ unchanged
{ npcMoveState = Set $ NPCStanding ttl future
, vel = Set $ V2 0 0
@ -127,13 +134,14 @@ getPath
-> MVar [V2 Int]
-> [ReachPoint]
-> M.Matrix (Maybe ImgId)
-> [(V2 Double, Boundaries Double)]
-> IO ()
getPath pos' mvar rp imgmat = do
getPath pos' mvar rp imgmat posbounds = 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'
path = astarAppl imgmat posbounds ntarget pos'
logIO A.Verbose ("seeking path from " ++ show pos' ++ " to " ++ show ntarget)
case path of
Nothing -> getPath pos' mvar rp imgmat
Nothing -> getPath pos' mvar rp imgmat posbounds
Just p -> putMVar mvar p

View file

@ -10,10 +10,15 @@ import Data.Maybe (isJust)
import Types
import Util
isReachable :: Matrix (Maybe ImgId) -> [V2 Int] -> [ReachPoint] -> Bool
isReachable imgmat reaches exits =
isReachable
:: Matrix (Maybe ImgId)
-> [(V2 Double, Boundaries Double)]
-> [V2 Int]
-> [ReachPoint]
-> Bool
isReachable imgmat animBounds reaches exits =
let result =
(concatMap
(\exit -> map (astarAppl imgmat exit) reaches)
(\exit -> map (astarAppl imgmat animBounds exit) reaches)
(map pointCoord exits))
in all isJust result

View file

@ -136,9 +136,14 @@ inBounds :: V2 Int -> Boundaries Int -> Bool
inBounds (V2 r c) (Boundaries (minr, minc) (maxr, maxc)) =
(r >= minr && r <= maxr) && (c >= minc && c <= maxc)
astarAppl :: Matrix (Maybe ImgId) -> V2 Int -> V2 Int -> Maybe [V2 Int]
astarAppl imgmat target = aStar
(naviGraph imgmat)
astarAppl
:: Matrix (Maybe ImgId)
-> [(V2 Double, Boundaries Double)]
-> V2 Int
-> V2 Int
-> Maybe [V2 Int]
astarAppl imgmat animBounds target = aStar
(naviGraph imgmat animBounds)
(\a b -> distance
(fmap (fromIntegral :: Int -> Double) a)
(fmap (fromIntegral :: Int -> Double) b)
@ -146,14 +151,21 @@ astarAppl imgmat target = aStar
(\a -> distance (fmap fromIntegral target) (fmap fromIntegral a))
(== target)
naviGraph :: Matrix (Maybe ImgId) -> V2 Int -> HS.HashSet (V2 Int)
naviGraph imgmat (V2 r c) =
naviGraph
:: Matrix (Maybe ImgId)
-> [(V2 Double, Boundaries Double)]
-> V2 Int
-> HS.HashSet (V2 Int)
naviGraph imgmat animBounds (V2 r c) =
let list1 =
foldl
(\acc (rr, cc) ->
if null
(maybe [] collisionObstacle
(fromMaybe Nothing $ M.safeGet (r + rr) (c + cc) imgmat))
((maybe [] collisionObstacle
(fromMaybe Nothing $ M.safeGet (r + rr) (c + cc) imgmat)) ++
(map snd $ filter
(\(V2 br bc, _) -> floor br == r + rr && floor bc == c + cc)
animBounds))
then V2 (r + rr) (c + cc): acc
else acc
)