hmmmm...

src/Test.hs

@@ -178,6 +178,19 @@ updateMap dt = do
   ud <- getAffection
   (nws, _) <- yieldSystemT (worldState ud) $ do
     emap $ do
+      without player
+      with vel
+      with pos
+      pos'@(V2 pr pc) <- E.get pos
+      vel' <- E.get vel
+      let npos@(V2 nr nc) = pos' + fmap (* (4 * dt)) vel'
+          dpos = npos - pos'
+          ent = defEntity'
+            { pos = Set $ npos
+            }
+      return ent
+    emap $ do
+      with player
       with vel
       with pos
       pos'@(V2 pr pc) <- E.get pos
@@ -186,7 +199,8 @@ updateMap dt = do
           dpos = npos - pos'
           ent = defEntity'
             { pos = Set $ pos' + dpos * Prelude.foldl
-              (checkBoundsCollision pos' npos)
+              (\acc a -> let ret = checkBoundsCollision2 pos' npos dt acc a
+                in A.log A.Debug (show ret) ret)
               (V2 1 1)
               (
                 concatMap
@@ -201,7 +215,7 @@ updateMap dt = do
                           (maxr + dr, maxc + dc)
                         ) bs
                   )
-                ((,) <$> [-1..1] <*> [-1..1])
+                ([(0, 0)])
               )
             }
       return ent
@@ -324,3 +338,27 @@ checkBoundsCollision
       hwidth = (maxc - minc) / 2
       ncdistsq = (ndistr - hheight) ^ (2 :: Int) + (ndistc - hwidth) ^ (2 :: Int)
       cdistsq = (distr - hheight) ^ (2 :: Int) + (distc - hwidth) ^ (2 :: Int)
+
+checkBoundsCollision2
+  :: V2 Double
+  -> V2 Double
+  -> Double
+  -> V2 Double
+  -> Boundaries Double
+  -> V2 Double
+checkBoundsCollision2
+  pre@(V2 pr pc) next@(V2 nr nc) dt acc (Boundaries (minr, minc) (maxr, maxc))
+    | colltr > dt && colltc > dt = acc
+    | colltr > dt = (V2 0 1) * acc
+    | colltc > dt = (V2 1 0) * acc
+    | otherwise                  = V2 0 0
+    where
+      vel@(V2 vr vc) = fmap (/ dt) (next - pre)
+      colltr
+        | vr > 0 = (((fromIntegral (floor nr :: Int)) + minr) - nr) / vr
+        | vr < 0 = (((fromIntegral (floor nr :: Int)) + maxr) - nr) / vr
+        | otherwise = dt
+      colltc
+        | vc > 0 = (((fromIntegral (floor nc :: Int)) + minc) - nc) / vc
+        | vc < 0 = (((fromIntegral (floor nc :: Int)) + maxc) - nc) / vc
+        | otherwise = dt

src/Util.hs

@@ -136,7 +136,7 @@ naviGraph imgmat (V2 r c) =
   let list1 =
         foldl
           (\acc (or, oc) ->
-            if null (imgObstacle $ imgmat M.! (r + or, c + oc))
+            if null (imgObstacle <$> M.safeGet (r + or) (c + oc) imgmat)
             then V2 (r + or) (c + oc): acc
             else acc
             )
@@ -145,10 +145,10 @@ naviGraph imgmat (V2 r c) =
       list2 =
         foldl
           (\acc (or, oc) ->
-            if null (imgObstacle $ imgmat M.! (r + or, c + oc))
+            if null (imgObstacle <$> M.safeGet (r + or) (c + oc) imgmat)
               && any null
               (map
-              (\(oor, ooc) -> imgObstacle $ imgmat M.! (r + oor, c + ooc))
+              (\(oor, ooc) -> imgObstacle <$> M.safeGet (r + oor) (c + ooc) imgmat)
               [(0, oc), (or, 0)])
             then V2 (r + or) (c + oc): acc
             else acc