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) pc (pc + ncols cmat - 1)
mat mat
))) || ))) ||
not (isReachable newmat (oldreaches ++ reaches) exits) not (isReachable newmat [] (oldreaches ++ reaches) exits)
then placeCluster g2 bnds (try + 1) mat rp appl then placeCluster g2 bnds (try + 1) mat rp appl
else placeCluster else placeCluster
g2 bnds (try + 1) newmat newrp appl 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) ) (A.log A.Debug ("number of copiers: " ++ show (length copiers)) copiers)
void $ liftIO $ swapMVar progress (18 / loadSteps, "Registering NPCs into WorldState") 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 mapM_ (\npcpos@(V2 nr nc) -> do
fact <- liftIO $ randomRIO (0.5, 1.5) fact <- liftIO $ randomRIO (0.5, 1.5)
fut <- liftIO newEmptyMVar 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 void $ createEntity $ newEntity
{ pos = Just (V2 (nr + 0.5) (nc + 0.5)) { pos = Just (V2 (nr + 0.5) (nc + 0.5))
, vel = Just (V2 0 0) , vel = Just (V2 0 0)

View file

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

View file

@ -10,10 +10,15 @@ import Data.Maybe (isJust)
import Types import Types
import Util import Util
isReachable :: Matrix (Maybe ImgId) -> [V2 Int] -> [ReachPoint] -> Bool isReachable
isReachable imgmat reaches exits = :: Matrix (Maybe ImgId)
-> [(V2 Double, Boundaries Double)]
-> [V2 Int]
-> [ReachPoint]
-> Bool
isReachable imgmat animBounds reaches exits =
let result = let result =
(concatMap (concatMap
(\exit -> map (astarAppl imgmat exit) reaches) (\exit -> map (astarAppl imgmat animBounds exit) reaches)
(map pointCoord exits)) (map pointCoord exits))
in all isJust result 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)) = inBounds (V2 r c) (Boundaries (minr, minc) (maxr, maxc)) =
(r >= minr && r <= maxr) && (c >= minc && c <= maxc) (r >= minr && r <= maxr) && (c >= minc && c <= maxc)
astarAppl :: Matrix (Maybe ImgId) -> V2 Int -> V2 Int -> Maybe [V2 Int] astarAppl
astarAppl imgmat target = aStar :: Matrix (Maybe ImgId)
(naviGraph imgmat) -> [(V2 Double, Boundaries Double)]
-> V2 Int
-> V2 Int
-> Maybe [V2 Int]
astarAppl imgmat animBounds target = aStar
(naviGraph imgmat animBounds)
(\a b -> distance (\a b -> distance
(fmap (fromIntegral :: Int -> Double) a) (fmap (fromIntegral :: Int -> Double) a)
(fmap (fromIntegral :: Int -> Double) b) (fmap (fromIntegral :: Int -> Double) b)
@ -146,14 +151,21 @@ astarAppl imgmat target = aStar
(\a -> distance (fmap fromIntegral target) (fmap fromIntegral a)) (\a -> distance (fmap fromIntegral target) (fmap fromIntegral a))
(== target) (== target)
naviGraph :: Matrix (Maybe ImgId) -> V2 Int -> HS.HashSet (V2 Int) naviGraph
naviGraph imgmat (V2 r c) = :: Matrix (Maybe ImgId)
-> [(V2 Double, Boundaries Double)]
-> V2 Int
-> HS.HashSet (V2 Int)
naviGraph imgmat animBounds (V2 r c) =
let list1 = let list1 =
foldl foldl
(\acc (rr, cc) -> (\acc (rr, cc) ->
if null if null
(maybe [] collisionObstacle ((maybe [] collisionObstacle
(fromMaybe Nothing $ M.safeGet (r + rr) (c + cc) imgmat)) (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 then V2 (r + rr) (c + cc): acc
else acc else acc
) )