tinkering with collision and movement
This commit is contained in:
parent
6a4c0e5b42
commit
8627f80be2
|
@ -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')
|
||||||
)
|
)
|
||||||
|
|
|
@ -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
|
||||||
)
|
)
|
||||||
|
|
|
@ -89,6 +89,7 @@ load level progress = do
|
||||||
100
|
100
|
||||||
tex
|
tex
|
||||||
False
|
False
|
||||||
|
Nothing
|
||||||
|
|
||||||
unbind vertexArray
|
unbind vertexArray
|
||||||
unbind vertexBuffer
|
unbind vertexBuffer
|
||||||
|
|
|
@ -80,4 +80,4 @@ update level dt = liftIO $ do
|
||||||
)
|
)
|
||||||
collidedCat
|
collidedCat
|
||||||
layer
|
layer
|
||||||
in Just $ move dt walledCat
|
in Just $ walledCat
|
||||||
|
|
|
@ -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
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in a new issue