collision check still not working

This commit is contained in:
nek0 2018-05-05 19:23:24 +02:00
parent a8beb8fca5
commit 4a8826b256

View file

@ -198,6 +198,21 @@ updateMap dt = do
vel' <- E.get vel vel' <- E.get vel
let npos@(V2 nr nc) = pos' + fmap (* (4 * dt)) vel' let npos@(V2 nr nc) = pos' + fmap (* (4 * dt)) vel'
dpos@(V2 dpr dpc) = npos - pos' dpos@(V2 dpr dpc) = npos - pos'
len = sqrt (dpos `dot` dpos)
lll = Prelude.map (\i ->
let lrow =
[ (nr - (fromIntegral $ floor nr))
, (nr - (fromIntegral $ floor nr)) + (dpr / len)
..
]
lcol =
[ (nc - (fromIntegral $ floor nc))
, (nc - (fromIntegral $ floor nc)) + (dpc / len)
..
]
in (fromIntegral (floor (lrow !! i)), fromIntegral (floor (lcol !! i)))
)
[ 0 .. floor len]
ent = defEntity' ent = defEntity'
{ pos = Set $ pos' + dpos * Prelude.foldl { pos = Set $ pos' + dpos * Prelude.foldl
(\acc a -> let ret = checkBoundsCollision2 pos' npos dt acc a (\acc a -> let ret = checkBoundsCollision2 pos' npos dt acc a
@ -216,17 +231,10 @@ updateMap dt = do
(maxr + dr, maxc + dc) (maxr + dr, maxc + dc)
) bs ) bs
) )
[ (fromIntegral lrow, fromIntegral lcol) | (A.log
lrow <- A.Verbose
[ (min (0 :: Int) (floor (nr - (fromIntegral $ floor nr)))) ("paassing relative tiles: " ++ show lll ++ " " ++ show len)
.. (max (0 :: Int) (floor (nr - (fromIntegral $ floor nr)))) lll)
],
lcol <-
[ (min (0 :: Int) (floor (nc - (fromIntegral $ floor nc))))
.. (max (0 :: Int) (floor (nc - (fromIntegral $ floor nc))))
],
fromIntegral lrow / dpr == fromIntegral lcol / dpc
]
) )
} }
return ent return ent
@ -359,17 +367,17 @@ checkBoundsCollision2
-> V2 Double -> V2 Double
checkBoundsCollision2 checkBoundsCollision2
pre@(V2 pr pc) next@(V2 nr nc) dt acc (Boundaries (minr, minc) (maxr, maxc)) pre@(V2 pr pc) next@(V2 nr nc) dt acc (Boundaries (minr, minc) (maxr, maxc))
| (colltr > dt || colltr < -0.1) && (colltc > dt || colltc < -0.1) = acc | colltr < 0 && colltc < 0 = V2 0 0
| (colltr > dt || colltr < -0.1) = (V2 1 0) * acc | colltr < 0 && colltc >= 0 = (V2 0 1) * acc
| (colltc > dt || colltc < -0.1) = (V2 0 1) * acc | colltc < 0 && colltr >= 0 = (V2 1 0) * acc
| otherwise = V2 0 0 | otherwise = acc
where where
vel@(V2 vr vc) = fmap (/ dt) (next - pre) vel@(V2 vr vc) = fmap (/ dt) (next - pre)
colltr colltr
| vr > 0 = (((fromIntegral (floor nr :: Int)) + minr - 0.15) - nr) / vr | vr > 0 = (((fromIntegral (floor nr :: Int)) + minr - 0.15) - nr) / vr
| vr < 0 = (((fromIntegral (floor nr :: Int)) + maxr + 0.15) - nr) / vr | vr < 0 = (((fromIntegral (floor nr :: Int)) + maxr + 0.15) - nr) / vr
| otherwise = dt | otherwise = 0
colltc colltc
| vc > 0 = (((fromIntegral (floor nc :: Int)) + minc - 0.15) - nc) / vc | vc > 0 = (((fromIntegral (floor nc :: Int)) + minc - 0.15) - nc) / vc
| vc < 0 = (((fromIntegral (floor nc :: Int)) + maxc + 0.15) - nc) / vc | vc < 0 = (((fromIntegral (floor nc :: Int)) + maxc + 0.15) - nc) / vc
| otherwise = dt | otherwise = 0