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
-> 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')
)

View File

@ -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
)

View File

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

View File

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

View File

@ -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
}
)