take obstacles from ECS into account

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

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)

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

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

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
             )