reworked collision again

This commit is contained in:
nek0 2021-01-14 23:08:24 +01:00
parent 8627f80be2
commit 430e2fff14
5 changed files with 73 additions and 77 deletions

View File

@ -26,41 +26,56 @@ 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
delta1@(V2 vx1 vy1) = (dt *) <$> velocity m1
delta2@(V2 vx2 vy2) = (dt *) <$> velocity m2
dtx 0 = dt
dtx vx =
if vx > 0
then ((m2x1 + vx2) - (m1x2 + vx1)) / vx
else ((m1x1 + vx1) - (m2x2 + vx2)) / (-vx)
dty 0 = dt
dty vy =
if vy > 0
then ((m2y1 + vy2) - (m1y2 + vy1)) / vy
else ((m1y1 + vy1) - (m2y2 + vy2)) / (-vy)
posColl =
or
[ m1x1 < m2x2 && m1x1 > m2x1
, m1x2 < m2x2 && m1x2 > m2x1
, m2x1 < m1x2 && m2x1 > m1x1
, m2x2 < m1x2 && m2x2 > m1x1
] && or
[ m1y1 < m2y2 && m1y1 > m2y1
, m1y2 < m2y2 && m1y2 > m2y1
, m2y1 < m1y2 && m2y1 > m1y1
, m2y2 < m1y2 && m2y2 > m1y1
]
let d1@(V2 d1x d1y) = (dt *) <$> velocity m1
d2@(V2 d2x d2y) = (dt *) <$> velocity m2
p1 = position m1
p2 = position m2
(m1b1@(V2 m1b1x m1b1y), m1b2@(V2 m1b2x m1b2y)) = boundary m1
(m2b1@(V2 m2b1x m2b1y), m2b2@(V2 m2b2x m2b2y)) = boundary m2
m1p1 = m1b1
m1p2 = V2 m1b1x m1b2y
m1p3 = m1b2
m1p4 = V2 m1b2x m1b1y
m2p1 = m2b1
m2p2 = V2 m2b1x m2b2y
m2p3 = m2b2
m2p4 = V2 m2b2x m2b1y
quad1 = map (p1 + d1 +) [m1p1, m1p2, m1p3, m1p4]
g1 = (m2p1, m2p2)
g2 = (m2p2, m2p3)
g3 = (m2p3, m2p4)
g4 = (m2p4, m2p1)
gs = map (\(s1, s2) -> (p2 + s1, p2 + s2)) [g1, g2, g3, g4]
t (V2 mqpx mqpy) (ps@(V2 mspx mspy), pt@(V2 mtpx mtpy)) =
if d1x == 0 && d1y == 0
then dt
else
((mtpx - mqpx) * (-(mtpy - mspy)) - (-(mtpx - mspx)) * (mspy - mqpy)) /
(d1x * (-(mtpy - mspy)) - (-(mtpx - mspx)) * d1y)
s (V2 mqpx mqpy) (ps@(V2 mspx mspy), pt@(V2 mtpx mtpy)) =
(d1x * (mtpy - mqpy) - (mtpx - mqpx) * d1y) /
(d1x * (-(mtpy - mspy)) - (-(mtpx - mspx)) * d1y)
inside m =
let am = m - (p2 + m2p1)
ab = (p2 + m2p2) - (p2 + m2p1)
ad = (p2 + m2p4) - (p2 + m2p1)
in
(0 < am `dot` ab && am `dot` ab < ab `dot` ab) &&
(0 < am `dot` ad && am `dot` ad < ad `dot` ad)
in
-- posColl || (dt > dtx vx1 || dt > dty vy1)
-- (if vx1 == 0 then posColl else dt > dtx vx1)
(posColl || dt > dtx vx1)
&&
-- (if vy1 == 0 then posColl else dt > dty vy1)
(posColl || dt > dty vy1)
any inside quad1 ||
any
(\gx ->
any
(\q ->
let qs = s q gx
qt = t q gx
in
(qs > 0 && qs < 1) && (qt > 0 && qt < dt)
)
quad1
)
gs
-- | This Function is called for every collision on both colliding objects.
collide
@ -90,29 +105,14 @@ elasticCollision damping mo1 mo2 =
v1x' = 2 * (m1 * v1x + m2 * v2x) / (m1 + m2) - v1x
v1y' = 2 * (m1 * v1y + m2 * v2y) / (m1 + m2) - v1y
(V2 dx dy) = p2 - p1
np = V2
( p1x + if v1x == 0
then 0
else
if dx < 0
then (abs m2x1 + abs m1x2 - abs dx)
else - (abs m2x2 + abs m1x1 - abs dx)
)
( p1y + if v1y == 0
then 0
else
if dy < 0
then (abs m2y1 + abs m1y2 - abs dy)
else - (abs m2y2 + abs m1y1 - abs dy)
)
in
(velocityUpdater ((positionUpdater mo1) np))
(if m1 == recip 0
nvel@(V2 nvx nvy) = if m1 == recip 0
then V2 0 0
else (damping *) <$>
if m2 == recip 0
then if abs dy < abs dx
then
if abs dy < abs dx
then (V2 (-v1x) v1y)
else (V2 v1x (-v1y))
else (V2 v1x' v1y')
)
in
(velocityUpdater mo1) nvel

View File

@ -59,6 +59,6 @@ class Mass m where
move dt m =
let dpos = ((dt *) <$> velocity m)
in
if quadrance dpos * sqrt 2 > dt
if quadrance dpos > 0.5
then (positionUpdater m) (position m + dpos)
else m

View File

@ -22,17 +22,9 @@ singleHandler
-> Affection ()
singleHandler level event = do
let multiplier = if tmKeyMotion event == SDL.Pressed then 1 else 0
changeDirection cat state dirVel =
changeDirection cat state =
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)) $
@ -46,7 +38,7 @@ singleHandler level event = do
)
else
Just pituicat
MoveRight -> changeDirection pituicat MoveRight catMoveVelocity
MoveLeft -> changeDirection pituicat MoveLeft (-catMoveVelocity)
MoveRight -> changeDirection pituicat MoveRight
MoveLeft -> changeDirection pituicat MoveLeft
_ -> Just pituicat
)

View File

@ -84,6 +84,7 @@ load level progress = do
let pituicat = Pituicat
(V2 100 1948)
(V2 0 1)
(V2 0 0)
(V2 0 0)
100

View File

@ -24,11 +24,12 @@ import Types.Texture
import Types.Subsystems
catMoveVelocity :: Double
catMoveVelocity = 1
catMoveVelocity = 10
data Pituicat = Pituicat
{ pcPos :: V2 Double
, pcVel :: V2 Double
, pcMoveVel :: V2 Double
, pcAcc :: V2 Double
, pcHealth :: Int
, pcTexture :: Texture
@ -39,7 +40,7 @@ data Pituicat = Pituicat
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
@ -78,14 +79,18 @@ instance Actor Pituicat where
(p {pcAcc = 0})
(V2 vx vy) = pcVel physCat
finalCat = physCat
{ 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
{ pcGrounded = (vy <= 0 && abs vy < 30 )
, pcMoveVel = case pcMoveState physCat of
Just MoveRight -> V2 catMoveVelocity 0
Just MoveLeft -> V2 (-catMoveVelocity) 0
_ -> V2 0 0
}
in
(A.log Debug ("moving with " <> fromString (show $ pcVel finalCat))) finalCat
(A.log Debug (
("being at " <> fromString (show $ pcPos finalCat)) <>
("; moving with " <> fromString (show $ pcVel finalCat))
)
) finalCat
instance Mass Pituicat where
@ -99,7 +104,7 @@ instance Mass Pituicat where
}
)
velocity = pcVel
velocity cat = pcVel cat + pcMoveVel cat
velocityUpdater cat =
(\vel -> cat
@ -131,6 +136,4 @@ instance Collidible Pituicat where
(V2 _ dy) = pcVel ncat
in
ncat
{ pcGrounded = dy > 0 && abs dy < 10
}
)