diff --git a/src/Test.hs b/src/Test.hs index 19df1ad..c1f44f9 100644 --- a/src/Test.hs +++ b/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 diff --git a/src/Util.hs b/src/Util.hs index e1e833a..631dc91 100644 --- a/src/Util.hs +++ b/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