nek0/pituicat
2
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

further attempt at physics

Browse source
This commit is contained in:
nek0 2021-04-16 21:47:02 +02:00
parent 9da16fc6a7
commit 134445ed20
1 changed files with 64 additions and 65 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

129
src/Classes/Physics/Collidible.hs
View file

@ -119,71 +119,70 @@ class (Show c, Mass c) => Collidible c where
in
if broadphaseOverlap
then
if tx <= ty
then
if tx < dt
then
if d1x <= 0
then
let (V2 _ g1s) = m1p1 + ((tx *) <$> d1)
(V2 _ g1e) = m1p2 + ((tx *) <$> d1)
(V2 _ g2s) = m2p4 + ((tx *) <$> d2)
(V2 _ g2e) = m2p3 + ((tx *) <$> d2)
s11 = (g1s - g2s) / (g2e - g2s)
s12 = (g1e - g2s) / (g2e - g2s)
s21 = (g2s - g1s) / (g1e - g1s)
s22 = (g2e - g1s) / (g1e - g1s)
in
if any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22]
then Collision tx (V2 (floor $ signum d1x) 0)
else NoCollision
else
let (V2 _ g1s) = m1p4 + ((tx *) <$> d1)
(V2 _ g1e) = m1p3 + ((tx *) <$> d1)
(V2 _ g2s) = m2p1 + ((tx *) <$> d2)
(V2 _ g2e) = m2p2 + ((tx *) <$> d2)
s11 = (g1s - g2s) / (g2e - g2s)
s12 = (g1e - g2s) / (g2e - g2s)
s21 = (g2s - g1s) / (g1e - g1s)
s22 = (g2e - g1s) / (g1e - g1s)
in
if any (\x -> x > 0 && x < 1) ((\s ->A.log A.Debug ("s: " <> fromString (show s)) s) [s11, s12, s21 ,s22])
then Collision tx (V2 (floor $ signum d1x) 0)
else NoCollision
else
NoCollision
else
if ty < dt
then
if d1y <= 0
then
let (V2 g1s _) = m1p1 + ((ty *) <$> d1)
(V2 g1e _) = m1p4 + ((ty *) <$> d1)
(V2 g2s _) = m2p2 + ((ty *) <$> d2)
(V2 g2e _) = m2p3 + ((ty *) <$> d2)
s11 = (g1s - g2s) / (g2e - g2s)
s12 = (g1e - g2s) / (g2e - g2s)
s21 = (g2s - g1s) / (g1e - g1s)
s22 = (g2e - g1s) / (g1e - g1s)
in
if any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22]
then Collision ty (V2 0 (floor $ signum d1y))
else NoCollision
else
let (V2 g1s _) = m1p2 + ((ty *) <$> d1)
(V2 g1e _) = m1p3 + ((ty *) <$> d1)
(V2 g2s _) = m2p1 + ((ty *) <$> d2)
(V2 g2e _) = m2p4 + ((ty *) <$> d2)
s11 = (g1s - g2s) / (g2e - g2s)
s12 = (g1e - g2s) / (g2e - g2s)
s21 = (g2s - g1s) / (g1e - g1s)
s22 = (g2e - g1s) / (g1e - g1s)
in
if any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22]
then Collision ty (V2 0 (floor $ signum d1y))
else NoCollision
else
NoCollision
let collx =
if d1x < 0
then
let (V2 _ g1s) = m1p1 + ((tx *) <$> d1)
(V2 _ g1e) = m1p2 + ((tx *) <$> d1)
(V2 _ g2s) = m2p4 + ((tx *) <$> d2)
(V2 _ g2e) = m2p3 + ((tx *) <$> d2)
s11 = (g1s - g2s) / (g2e - g2s)
s12 = (g1e - g2s) / (g2e - g2s)
s21 = (g2s - g1s) / (g1e - g1s)
s22 = (g2e - g1s) / (g1e - g1s)
in
any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22]
else
let (V2 _ g1s) = m1p4 + ((tx *) <$> d1)
(V2 _ g1e) = m1p3 + ((tx *) <$> d1)
(V2 _ g2s) = m2p1 + ((tx *) <$> d2)
(V2 _ g2e) = m2p2 + ((tx *) <$> d2)
s11 = (g1s - g2s) / (g2e - g2s)
s12 = (g1e - g2s) / (g2e - g2s)
s21 = (g2s - g1s) / (g1e - g1s)
s22 = (g2e - g1s) / (g1e - g1s)
in
any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22]
colly =
if d1y < 0
then
let (V2 g1s _) = m1p1 + ((ty *) <$> d1)
(V2 g1e _) = m1p4 + ((ty *) <$> d1)
(V2 g2s _) = m2p2 + ((ty *) <$> d2)
(V2 g2e _) = m2p3 + ((ty *) <$> d2)
s11 = (g1s - g2s) / (g2e - g2s)
s12 = (g1e - g2s) / (g2e - g2s)
s21 = (g2s - g1s) / (g1e - g1s)
s22 = (g2e - g1s) / (g1e - g1s)
in
any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22]
else
let (V2 g1s _) = m1p2 + ((ty *) <$> d1)
(V2 g1e _) = m1p3 + ((ty *) <$> d1)
(V2 g2s _) = m2p1 + ((ty *) <$> d2)
(V2 g2e _) = m2p4 + ((ty *) <$> d2)
s11 = (g1s - g2s) / (g2e - g2s)
s12 = (g1e - g2s) / (g2e - g2s)
s21 = (g2s - g1s) / (g1e - g1s)
s22 = (g2e - g1s) / (g1e - g1s)
in
any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22]
in
case (tx < dt, ty < dt, tx < ty, collx, colly) of
(_, _, True, True, _) ->
Collision tx (V2 (floor $ signum d1x) 0)
(_, _, False, _, True) ->
Collision ty (V2 0 (floor $ signum d1y))
(_, _, _, False, False) ->
NoCollision
--(True, _, _, False, _) ->
-- NoCollision
-- (_, True, _, _, False) ->
-- NoCollision
-- (False, _, _, _, _) ->
-- NoCollision
-- (_, False, _, _, _) ->
-- NoCollision
else
NoCollision