From f64aae86f030e5d6ae41abc6677de286dce6c684 Mon Sep 17 00:00:00 2001
From: nek0 <nek0@chelnok.de>
Date: Sat, 21 Jul 2018 21:10:32 +0200
Subject: [PATCH] take obstacles from ECS into account

---
 src/Interior.hs          |  2 +-
 src/MainGame/WorldMap.hs |  9 ++++++++-
 src/NPC.hs               | 18 +++++++++++++-----
 src/Navigation.hs        | 11 ++++++++---
 src/Util.hs              | 26 +++++++++++++++++++-------
 5 files changed, 49 insertions(+), 17 deletions(-)

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
             )