From bbd57c8ed1018a21ca91e01d0ca995815f0dbbe1 Mon Sep 17 00:00:00 2001
From: nek0 <nek0@nek0.eu>
Date: Fri, 15 Feb 2019 20:02:55 +0100
Subject: [PATCH] enable collision detection for NPCs

---
 src/MainGame/WorldMap.hs | 53 ++++++++++++++++++++++++++++++++++------
 1 file changed, 45 insertions(+), 8 deletions(-)

diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs
index 830de5b..716fee9 100644
--- a/src/MainGame/WorldMap.hs
+++ b/src/MainGame/WorldMap.hs
@@ -791,6 +791,12 @@ updateMap dt = do
         return $ unchanged
           { anim = Set nstate
           }
+      obstacleBounds <- efor allEnts $ do
+        with obstacle
+        with pos
+        b <- query obstacle
+        pos' <- query pos
+        return (pos', b)
       emap allEnts $ do
         without player
         with vel
@@ -798,13 +804,50 @@ updateMap dt = do
         with pos
         with rot
         with anim
-        pos' <- query pos
+        pos'@(V2 pr pc) <- query pos
         vel' <- query vel
         rot' <- query rot
         fact' <- query velFact
         stat <- query anim
         let npos = pos' + fmap (* (dt * fact')) vel'
+            dpos@(V2 dpr dpc) = npos - pos'
             aId = asId stat
+            lll = (,)
+              <$> (
+                if dpr < 0
+                then [(floor dpr :: Int) .. 0]
+                else [0 .. (ceiling dpr :: Int)])
+              <*> (
+                if dpc < 0
+                then [(floor dpc :: Int) .. 0]
+                else [0 .. (ceiling dpc :: Int)])
+            colldpos = dpos * Prelude.foldl
+              (\acc a ->
+                let ret = checkBoundsCollision2 pos' npos dt acc a
+                in A.log A.Verbose (show ret) ret)
+              (V2 1 1)
+              (
+                concatMap
+                (\(dr, dc) ->
+                  let bs = (++)
+                        (maybe [] collisionObstacle (fromMaybe Nothing $ M.safeGet
+                          (fromIntegral $ floor pr + dr)
+                          (fromIntegral $ floor pc + dc)
+                          (imgMat (stateData ud))))
+                        (Prelude.map snd $ Prelude.filter
+                          (\((V2 br bc), _) ->
+                            floor pr + dr == floor br &&
+                            floor pc + dc == floor bc
+                            )
+                          obstacleBounds)
+                  in  Prelude.map (\(Boundaries (minr, minc) (maxr, maxc))->
+                        Boundaries
+                          (minr + fromIntegral dr, minc + fromIntegral dc)
+                          (maxr + fromIntegral dr, maxc + fromIntegral dc)
+                        ) bs
+                  )
+                lll -- (A.log A.Verbose (show lll ++ " " ++ show len) lll)
+                )
             nstat = case aiName aId of
               "walking"
                 | sqrt (vel' `dot` vel') > 0 ->
@@ -838,17 +881,11 @@ updateMap dt = do
                     }
               x -> error ("unknown animation name" ++ x)
             ent = unchanged
-              { pos = Set npos
+              { pos = Set $ pos' + colldpos
               , rot = Set $ fromMaybe rot' (direction vel')
               , anim = Set nstat
               }
         return ent
-      obstacleBounds <- efor allEnts $ do
-        with obstacle
-        with pos
-        b <- query obstacle
-        pos' <- query pos
-        return (pos', b)
       emap allEnts $ do
         with player
         with vel