From ccfc7aaac6dd364677eb59705516bbc13f78a6f0 Mon Sep 17 00:00:00 2001
From: nek0 <nek0@chelnok.de>
Date: Tue, 6 Mar 2018 16:37:21 +0100
Subject: [PATCH] fix ghosting

---
 src/Test.hs | 27 ++++++++++++++++-----------
 1 file changed, 16 insertions(+), 11 deletions(-)

diff --git a/src/Test.hs b/src/Test.hs
index e3ed0e1..1aef5a0 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -149,10 +149,13 @@ updateMap dt = do
       pos'@(V2 or oc) <- E.get pos
       vel' <- E.get vel
       let npos@(V2 nr nc) = pos' + fmap (* (4 * dt)) vel'
-      let ent = defEntity'
-            { pos = Set $ Prelude.foldl (checkBoundsCollision pos')
-              npos
-              (imgObstacle (imgMat (stateData ud) M.! (floor nr, floor nc)))
+          dpos = npos - pos'
+          ent = defEntity'
+            { pos = Set $ pos' + dpos * Prelude.foldl
+              (checkBoundsCollision pos' npos)
+              (V2 1 1)
+              ((imgObstacle (imgMat (stateData ud) M.! (floor nr, floor nc))) ++
+              (imgObstacle (imgMat (stateData ud) M.! (floor or, floor oc))))
             }
       return ent
   putAffection ud
@@ -241,38 +244,40 @@ drawTile ai ctx pr pc row col img =
 checkBoundsCollision
   :: V2 Double
   -> V2 Double
+  -> V2 Double
   -> Boundaries Double
   -> V2 Double
 checkBoundsCollision
-  pos'@(V2 or oc) acc@(V2 fr fc) (Boundaries (minr, minc) (maxr, maxc))
+  pos@(V2 or oc) npos@(V2 fr fc) acc@(V2 mr mc)
+  (Boundaries (minr, minc) (maxr, maxc))
     | (fr - fromIntegral (floor fr) >= minr &&
       fr - fromIntegral (floor fr) <= maxr) &&
       (fc - fromIntegral (floor fc) >= minc &&
       fc - fromIntegral (floor fc) <= maxc) &&
       (or - fromIntegral (floor or) < minr ||
       or - fromIntegral (floor or) > maxr) =
-      (V2 or fc)
+      (V2 (0 * mr) (1 * mc))
     | (fr - fromIntegral (floor fr) >= minr &&
       fr - fromIntegral (floor fr) <= maxr) &&
       (fc - fromIntegral (floor fc) >= minc &&
       fc - fromIntegral (floor fc) <= maxc) &&
       (oc - fromIntegral (floor oc) < minc ||
       oc - fromIntegral (floor oc) > maxc) =
-      (V2 fr oc)
+      (V2 (1 * mr) (0 * mc))
     | (fr - fromIntegral (floor fr) < minr ||
       fr - fromIntegral (floor fr) > maxr) &&
       (fc - fromIntegral (floor fc) < minc ||
       fc - fromIntegral (floor fc) > maxc) =
-      acc
+      (V2 (1 * mr) (1 * mc))
     | (fr - fromIntegral (floor fr) < minr ||
       fr - fromIntegral (floor fr) > maxr) &&
       (fc - fromIntegral (floor fc) >= minc &&
       fc - fromIntegral (floor fc) <= maxc) =
-      acc
+      (V2 (1 * mr) (1 * mc))
     | (fr - fromIntegral (floor fr) >= minr &&
       fr - fromIntegral (floor fr) <= maxr) &&
       (fc - fromIntegral (floor fc) < minc ||
       fc - fromIntegral (floor fc) > maxc) =
-      acc
+      (V2 (1 * mr) (1 * mc))
     | otherwise =
-      pos'
+      (V2 (0 * mr) (0 * mc))