tinkering with collision and movement

This commit is contained in:
nek0 2021-01-12 03:12:02 +01:00
parent 6a4c0e5b42
commit 8627f80be2
5 changed files with 52 additions and 25 deletions

View file

@ -26,22 +26,22 @@ class (Show c, Mass c) => Collidible c where
-> other -- ^ second object -> other -- ^ second object
-> Bool -- ^ Do the objects collide? -> Bool -- ^ Do the objects collide?
collisionCheck dt m1 m2 = collisionCheck dt m1 m2 =
let (V2 m1x1 m1y1) = position m1 + fst (boundary m1) + delta1 let (V2 m1x1 m1y1) = position m1 + fst (boundary m1) -- + delta1
(V2 m1x2 m1y2) = position m1 + snd (boundary m1) + delta1 (V2 m1x2 m1y2) = position m1 + snd (boundary m1) -- + delta1
(V2 m2x1 m2y1) = position m2 + fst (boundary m2) + delta2 (V2 m2x1 m2y1) = position m2 + fst (boundary m2) -- + delta2
(V2 m2x2 m2y2) = position m2 + snd (boundary m2) + delta2 (V2 m2x2 m2y2) = position m2 + snd (boundary m2) -- + delta2
delta1@(V2 vx1 vy1) = (dt *) <$> velocity m1 delta1@(V2 vx1 vy1) = (dt *) <$> velocity m1
delta2 = (dt *) <$> velocity m2 delta2@(V2 vx2 vy2) = (dt *) <$> velocity m2
dtx 0 = dt dtx 0 = dt
dtx vx = dtx vx =
if vx > 0 if vx > 0
then (m2x1 - m1x2) / vx then ((m2x1 + vx2) - (m1x2 + vx1)) / vx
else (m1x1 - m2x2) / (-vx) else ((m1x1 + vx1) - (m2x2 + vx2)) / (-vx)
dty 0 = dt dty 0 = dt
dty vy = dty vy =
if vy > 0 if vy > 0
then (m2y1 - m1y2) / vy then ((m2y1 + vy2) - (m1y2 + vy1)) / vy
else (m1y1 - m2y2) / (-vy) else ((m1y1 + vy1) - (m2y2 + vy2)) / (-vy)
posColl = posColl =
or or
[ m1x1 < m2x2 && m1x1 > m2x1 [ m1x1 < m2x2 && m1x1 > m2x1
@ -55,11 +55,12 @@ class (Show c, Mass c) => Collidible c where
, m2y2 < m1y2 && m2y2 > m1y1 , m2y2 < m1y2 && m2y2 > m1y1
] ]
in in
-- posColl || (dt > dtx vx1 || dt > dty vy1)
-- (if vx1 == 0 then posColl else dt > dtx vx1) -- (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) -- (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. -- | This Function is called for every collision on both colliding objects.
collide collide
@ -67,7 +68,7 @@ class (Show c, Mass c) => Collidible c where
=> c -- ^ Original object => c -- ^ Original object
-> other -- ^ Collision partner -> other -- ^ Collision partner
-> c -- ^ Updated original object -> c -- ^ Updated original object
collide = elasticCollision 0.9 collide = elasticCollision 1
-- | Implementation of a dampened elastic collision used as default collision -- | Implementation of a dampened elastic collision used as default collision
-- implementation of the collision reaction -- implementation of the collision reaction
@ -110,6 +111,8 @@ elasticCollision damping mo1 mo2 =
then V2 0 0 then V2 0 0
else (damping *) <$> else (damping *) <$>
if m2 == recip 0 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') else (V2 v1x' v1y')
) )

View file

@ -22,6 +22,18 @@ singleHandler
-> Affection () -> Affection ()
singleHandler level event = do singleHandler level event = do
let multiplier = if tmKeyMotion event == SDL.Pressed then 1 else 0 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) -> liftIO $ atomically $ modifyTVar (testPlayer level) (\(Just pituicat) ->
A.log Debug ("Grounded: " <> fromString (show $ pcGrounded pituicat)) $ A.log Debug ("Grounded: " <> fromString (show $ pcGrounded pituicat)) $
case tmAction event of case tmAction event of
@ -34,5 +46,7 @@ singleHandler level event = do
) )
else else
Just pituicat Just pituicat
MoveRight -> changeDirection pituicat MoveRight catMoveVelocity
MoveLeft -> changeDirection pituicat MoveLeft (-catMoveVelocity)
_ -> Just pituicat _ -> Just pituicat
) )

View file

@ -89,6 +89,7 @@ load level progress = do
100 100
tex tex
False False
Nothing
unbind vertexArray unbind vertexArray
unbind vertexBuffer unbind vertexBuffer

View file

@ -80,4 +80,4 @@ update level dt = liftIO $ do
) )
collidedCat collidedCat
layer layer
in Just $ move dt walledCat in Just $ walledCat

View file

@ -21,20 +21,25 @@ import Classes.Physics
import Types.Graphics.VertexBuffer import Types.Graphics.VertexBuffer
import Types.Texture import Types.Texture
import Types.Subsystems
catMoveVelocity :: Double
catMoveVelocity = 1
data Pituicat = Pituicat data Pituicat = Pituicat
{ pcPos :: V2 Double { pcPos :: V2 Double
, pcVel :: V2 Double , pcVel :: V2 Double
, pcAcc :: V2 Double , pcAcc :: V2 Double
, pcHealth :: Int , pcHealth :: Int
, pcTexture :: Texture , pcTexture :: Texture
, pcGrounded :: Bool , pcGrounded :: Bool
, pcMoveState :: Maybe Action
} }
deriving (Eq, Show) deriving (Eq, Show)
instance Drawable Pituicat where instance Drawable Pituicat where
toVertices (Pituicat (V2 x y) _ _ _ _ _) = toVertices (Pituicat (V2 x y) _ _ _ _ _ _) =
( V.fromList [0, 1, 2, 2, 3, 0] ( V.fromList [0, 1, 2, 2, 3, 0]
, V.fromList , V.fromList
[ newVertex [ newVertex
@ -69,11 +74,15 @@ instance Prop Pituicat where
instance Actor Pituicat where instance Actor Pituicat where
perform dt p = perform dt p =
let physCat = (accelerate dt . gravitate constG) let physCat = (move dt . accelerate dt . gravitate constG)
(p {pcAcc = 0}) (p {pcAcc = 0})
(V2 _ dy) = pcVel physCat (V2 vx vy) = pcVel physCat
finalCat = 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 in
(A.log Debug ("moving with " <> fromString (show $ pcVel finalCat))) finalCat (A.log Debug ("moving with " <> fromString (show $ pcVel finalCat))) finalCat
@ -122,6 +131,6 @@ instance Collidible Pituicat where
(V2 _ dy) = pcVel ncat (V2 _ dy) = pcVel ncat
in in
ncat ncat
{ pcGrounded = dy > 0 && abs dy < 2 { pcGrounded = dy > 0 && abs dy < 10
} }
) )