From 8627f80be204a1e343c1dd9edf29472eacc5a6bb Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 12 Jan 2021 03:12:02 +0100 Subject: [PATCH] tinkering with collision and movement --- src/Classes/Physics/Collidible.hs | 29 ++++++++++++++++------------- src/Scenes/Test/EventHandler.hs | 14 ++++++++++++++ src/Scenes/Test/Load.hs | 1 + src/Scenes/Test/Update.hs | 2 +- src/Types/Player.hs | 31 ++++++++++++++++++++----------- 5 files changed, 52 insertions(+), 25 deletions(-) diff --git a/src/Classes/Physics/Collidible.hs b/src/Classes/Physics/Collidible.hs index b880521..45e5110 100644 --- a/src/Classes/Physics/Collidible.hs +++ b/src/Classes/Physics/Collidible.hs @@ -26,22 +26,22 @@ class (Show c, Mass c) => Collidible c where -> other -- ^ second object -> Bool -- ^ Do the objects collide? collisionCheck dt m1 m2 = - let (V2 m1x1 m1y1) = position m1 + fst (boundary m1) + delta1 - (V2 m1x2 m1y2) = position m1 + snd (boundary m1) + delta1 - (V2 m2x1 m2y1) = position m2 + fst (boundary m2) + delta2 - (V2 m2x2 m2y2) = position m2 + snd (boundary m2) + delta2 + let (V2 m1x1 m1y1) = position m1 + fst (boundary m1) -- + delta1 + (V2 m1x2 m1y2) = position m1 + snd (boundary m1) -- + delta1 + (V2 m2x1 m2y1) = position m2 + fst (boundary m2) -- + delta2 + (V2 m2x2 m2y2) = position m2 + snd (boundary m2) -- + delta2 delta1@(V2 vx1 vy1) = (dt *) <$> velocity m1 - delta2 = (dt *) <$> velocity m2 + delta2@(V2 vx2 vy2) = (dt *) <$> velocity m2 dtx 0 = dt dtx vx = if vx > 0 - then (m2x1 - m1x2) / vx - else (m1x1 - m2x2) / (-vx) + then ((m2x1 + vx2) - (m1x2 + vx1)) / vx + else ((m1x1 + vx1) - (m2x2 + vx2)) / (-vx) dty 0 = dt dty vy = if vy > 0 - then (m2y1 - m1y2) / vy - else (m1y1 - m2y2) / (-vy) + then ((m2y1 + vy2) - (m1y2 + vy1)) / vy + else ((m1y1 + vy1) - (m2y2 + vy2)) / (-vy) posColl = or [ m1x1 < m2x2 && m1x1 > m2x1 @@ -55,11 +55,12 @@ class (Show c, Mass c) => Collidible c where , m2y2 < m1y2 && m2y2 > m1y1 ] in + -- posColl || (dt > dtx vx1 || dt > dty vy1) -- (if vx1 == 0 then posColl else dt > dtx vx1) - (dt > dtx vx1 || posColl) + (posColl || dt > dtx vx1) && -- (if vy1 == 0 then posColl else dt > dty vy1) - (dt > dty vy1 || posColl) + (posColl || dt > dty vy1) -- | This Function is called for every collision on both colliding objects. collide @@ -67,7 +68,7 @@ class (Show c, Mass c) => Collidible c where => c -- ^ Original object -> other -- ^ Collision partner -> c -- ^ Updated original object - collide = elasticCollision 0.9 + collide = elasticCollision 1 -- | Implementation of a dampened elastic collision used as default collision -- implementation of the collision reaction @@ -110,6 +111,8 @@ elasticCollision damping mo1 mo2 = then V2 0 0 else (damping *) <$> if m2 == recip 0 - then negate <$> velocity mo1 + then if abs dy < abs dx + then (V2 (-v1x) v1y) + else (V2 v1x (-v1y)) else (V2 v1x' v1y') ) diff --git a/src/Scenes/Test/EventHandler.hs b/src/Scenes/Test/EventHandler.hs index afb96a9..d2d2f4e 100644 --- a/src/Scenes/Test/EventHandler.hs +++ b/src/Scenes/Test/EventHandler.hs @@ -22,6 +22,18 @@ singleHandler -> Affection () singleHandler level event = do let multiplier = if tmKeyMotion event == SDL.Pressed then 1 else 0 + changeDirection cat state dirVel = + Just cat + { pcMoveState = if multiplier > 0 then Just state else Nothing + , pcVel = if multiplier > 0 + then pcVel cat + V2 dirVel 0 + else + let (V2 vx vy) = pcVel cat + in + if abs vx - dirVel < 0 + then V2 0 vy + else V2 (vx - dirVel) vy + } liftIO $ atomically $ modifyTVar (testPlayer level) (\(Just pituicat) -> A.log Debug ("Grounded: " <> fromString (show $ pcGrounded pituicat)) $ case tmAction event of @@ -34,5 +46,7 @@ singleHandler level event = do ) else Just pituicat + MoveRight -> changeDirection pituicat MoveRight catMoveVelocity + MoveLeft -> changeDirection pituicat MoveLeft (-catMoveVelocity) _ -> Just pituicat ) diff --git a/src/Scenes/Test/Load.hs b/src/Scenes/Test/Load.hs index 4a9c4c8..cc3c4f6 100644 --- a/src/Scenes/Test/Load.hs +++ b/src/Scenes/Test/Load.hs @@ -89,6 +89,7 @@ load level progress = do 100 tex False + Nothing unbind vertexArray unbind vertexBuffer diff --git a/src/Scenes/Test/Update.hs b/src/Scenes/Test/Update.hs index 923f303..e600c01 100644 --- a/src/Scenes/Test/Update.hs +++ b/src/Scenes/Test/Update.hs @@ -80,4 +80,4 @@ update level dt = liftIO $ do ) collidedCat layer - in Just $ move dt walledCat + in Just $ walledCat diff --git a/src/Types/Player.hs b/src/Types/Player.hs index 91f063a..0a58b6b 100644 --- a/src/Types/Player.hs +++ b/src/Types/Player.hs @@ -21,20 +21,25 @@ import Classes.Physics import Types.Graphics.VertexBuffer import Types.Texture +import Types.Subsystems + +catMoveVelocity :: Double +catMoveVelocity = 1 data Pituicat = Pituicat - { pcPos :: V2 Double - , pcVel :: V2 Double - , pcAcc :: V2 Double - , pcHealth :: Int - , pcTexture :: Texture - , pcGrounded :: Bool + { pcPos :: V2 Double + , pcVel :: V2 Double + , pcAcc :: V2 Double + , pcHealth :: Int + , pcTexture :: Texture + , pcGrounded :: Bool + , pcMoveState :: Maybe Action } deriving (Eq, Show) instance Drawable Pituicat where - toVertices (Pituicat (V2 x y) _ _ _ _ _) = + toVertices (Pituicat (V2 x y) _ _ _ _ _ _) = ( V.fromList [0, 1, 2, 2, 3, 0] , V.fromList [ newVertex @@ -69,11 +74,15 @@ instance Prop Pituicat where instance Actor Pituicat where perform dt p = - let physCat = (accelerate dt . gravitate constG) + let physCat = (move dt . accelerate dt . gravitate constG) (p {pcAcc = 0}) - (V2 _ dy) = pcVel physCat + (V2 vx vy) = pcVel physCat finalCat = physCat - { pcGrounded = pcGrounded physCat || (dy < 0 && abs dy < 2) + { pcGrounded = pcGrounded physCat || (vy < 0 && abs vy < 2) + , pcVel = case pcMoveState physCat of + Just MoveRight -> V2 (min catMoveVelocity vx) vy + Just MoveLeft -> V2 (min (-catMoveVelocity) vx) vy + _ -> V2 vx vy } in (A.log Debug ("moving with " <> fromString (show $ pcVel finalCat))) finalCat @@ -122,6 +131,6 @@ instance Collidible Pituicat where (V2 _ dy) = pcVel ncat in ncat - { pcGrounded = dy > 0 && abs dy < 2 + { pcGrounded = dy > 0 && abs dy < 10 } )