From 7657a35415622391d70fbfba5c92de900d0a7fc9 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 17 Apr 2021 04:53:21 +0200 Subject: [PATCH] first cleanup --- src/Classes/Physics/Collidible.hs | 160 ++++++++---------------------- 1 file changed, 40 insertions(+), 120 deletions(-) diff --git a/src/Classes/Physics/Collidible.hs b/src/Classes/Physics/Collidible.hs index 2461b56..1587651 100644 --- a/src/Classes/Physics/Collidible.hs +++ b/src/Classes/Physics/Collidible.hs @@ -8,8 +8,6 @@ import Linear import Data.String (fromString) -import Data.List (minimumBy) - -- internal imports import Classes.Physics.Mass @@ -55,17 +53,7 @@ class (Show c, Mass c) => Collidible c where m2p2 = p2 + V2 m2b1x m2b2y m2p3 = p2 + m2b2 m2p4 = p2 + V2 m2b2x m2b1y - -- g11 = (m1p1, m1p2) - -- g12 = (m1p2, m1p3) - -- g13 = (m1p3, m1p4) - -- g14 = (m1p4, m1p1) - -- g21 = (m2p1, m2p2) - -- g22 = (m2p2, m2p3) - -- g23 = (m2p3, m2p4) - -- g24 = (m2p4, m2p1) - -- g1s = [g11, g12, g13, g14] - -- g2s = [g21, g22, g23, g24] - b1 = + (V2 b1minx b1miny, V2 b1maxx b1maxy) = ( V2 ((\(V2 x _) -> x) (if d1x < 0 then m1p1 + ((dt *) <$> d1) else m1p1)) ((\(V2 _ y) -> y) (if d1y < 0 then m1p1 + ((dt *) <$> d1) else m1p1)) @@ -73,7 +61,7 @@ class (Show c, Mass c) => Collidible c where ((\(V2 x _) -> x) (if d1x < 0 then m1p3 else m1p3 + ((dt *) <$> d1))) ((\(V2 _ y) -> y) (if d1y < 0 then m1p3 else m1p3 + ((dt *) <$> d1))) ) - b2 = + (V2 b2minx b2miny, V2 b2maxx b2maxy) = ( V2 ((\(V2 x _) -> x) (if d2x < 0 then m2p1 + ((dt *) <$> d2) else m2p1)) ((\(V2 _ y) -> y) (if d2y < 0 then m2p1 + ((dt *) <$> d2) else m2p1)) @@ -82,11 +70,7 @@ class (Show c, Mass c) => Collidible c where ((\(V2 _ y) -> y) (if d2y < 0 then m2p3 else m2p3 + ((dt *) <$> d2))) ) broadphaseOverlap = - let b11@(V2 b1minx b1miny) = fst b1 - b12@(V2 b1maxx b1maxy) = snd b1 - b21@(V2 b2minx b2miny) = fst b2 - b22@(V2 b2maxx b2maxy) = snd b2 - in2 = + let in2 = (b1minx > b2minx && b1minx < b2maxx && b1miny > b2miny && b1miny < b2maxy) || (b1maxx > b2minx && b1maxx < b2maxx && @@ -119,54 +103,40 @@ class (Show c, Mass c) => Collidible c where in if broadphaseOverlap then - 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] + let collx = + let (p11, p12, p21, p22) = + if d1x < 0 + then + (m1p1, m1p2, m2p4, m2p3) + else + (m1p4, m1p3, m2p1, m2p2) + (V2 _ g1s) = p11 + ((tx *) <$> d1) + (V2 _ g1e) = p12 + ((tx *) <$> d1) + (V2 _ g2s) = p21 + ((tx *) <$> d2) + (V2 _ g2e) = p22 + ((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] + let (p11, p12, p21, p22) = + if d1y < 0 + then + (m1p1, m1p4, m2p2, m2p3) + else + (m1p2, m1p3, m2p1, m2p4) + (V2 g1s _) = p11 + ((ty *) <$> d1) + (V2 g1e _) = p12 + ((ty *) <$> d1) + (V2 g2s _) = p21 + ((ty *) <$> d2) + (V2 g2e _) = p22 + ((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] res = case (tx < dt, ty < dt, tx < ty, collx, colly) of (True, _, True, True, _) -> @@ -207,19 +177,15 @@ elasticCollision -> CollisionResult Double (V2 Int) -> c1 elasticCollision _ mo1 _ NoCollision = mo1 -elasticCollision damping mo1 mo2 (Collision ddt (V2 dirx diry)) = +elasticCollision damping mo1 mo2 (Collision ddt (V2 dirx _)) = let v1@(V2 v1x v1y) = velocity mo1 (V2 v2x v2y) = velocity mo2 - p1@(V2 p1x p1y) = position mo1 - p2 = position mo2 - (V2 m1x1 m1y1, V2 m1x2 m1y2) = boundary mo1 - (V2 m2x1 m2y1, V2 m2x2 m2y2) = boundary mo2 + p1 = position mo1 m1 = mass mo1 m2 = mass mo2 v1x' = 2 * (m1 * v1x + m2 * v2x) / (m1 + m2) - v1x v1y' = 2 * (m1 * v1y + m2 * v2y) / (m1 + m2) - v1y - (V2 dx dy) = p2 - p1 - nvel@(V2 nvx nvy) = if m1 == recip 0 + nvel = if m1 == recip 0 then V2 0 0 else (damping *) <$> if m2 == recip 0 @@ -228,53 +194,7 @@ elasticCollision damping mo1 mo2 (Collision ddt (V2 dirx diry)) = then (V2 (-v1x) v1y) else (V2 v1x (-v1y)) else (V2 v1x' v1y') - bx = if dx < 0 - then - if abs dx > abs m1x1 + abs m2x2 && - (if dy > 0 - then abs dy > abs m1y2 + abs m2y1 - else abs dy > abs m1y1 + abs m2y2 - ) - then 0 - else (abs m1x1 + abs m2x2) - abs dx - else - if abs dx > abs m1x2 + abs m2x1 && - (if dy > 0 - then abs dy > abs m1y2 + abs m2y1 - else abs dy > abs m1y1 + abs m2y2 - ) - then 0 - else -((abs m1x2 + abs m2x1) - abs dx) - by = if dy < 0 - then - if abs dy > abs m1y1 + abs m2y2 && - (if dx > 0 - then abs dx > abs m1x2 + abs m2x1 - else abs dx > abs m1x1 + abs m2x2 - ) - then 0 - else (abs m1y1 + abs m2y2) - abs dy - else - if abs dy > abs m1y2 + abs m2y1 && - (if dx > 0 - then abs dx > abs m1x2 + abs m2x1 - else abs dx > abs m1x1 + abs m2x2 - ) - then 0 - else -((abs m1y2 + abs m2y1) - abs dy) in (velocityUpdater - ((positionUpdater mo1) - (p1 + ((ddt *) <$> v1) - -- if ddt == 0 - -- then - -- if abs bx < abs by - -- then - -- V2 bx 0 - -- else - -- V2 0 by - -- else - -- V2 0 0 - ) - ) + ((positionUpdater mo1) (p1 + ((ddt *) <$> v1))) ) nvel