diff --git a/src/Interior.hs b/src/Interior.hs index b395ad7..54962cc 100644 --- a/src/Interior.hs +++ b/src/Interior.hs @@ -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 diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index 1018773..7c77d4b 100644 --- a/src/MainGame/WorldMap.hs +++ b/src/MainGame/WorldMap.hs @@ -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) diff --git a/src/NPC.hs b/src/NPC.hs index 45d1c1b..0680a18 100644 --- a/src/NPC.hs +++ b/src/NPC.hs @@ -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 diff --git a/src/Navigation.hs b/src/Navigation.hs index d14b9d2..14d4797 100644 --- a/src/Navigation.hs +++ b/src/Navigation.hs @@ -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 diff --git a/src/Util.hs b/src/Util.hs index c04f43e..c455d27 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -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 )