nek0/pituicat
2
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

trying to shove things around

Browse source
This commit is contained in:
nek0 2021-07-26 06:28:40 +02:00
parent 337fcf9cd0
commit b53d93b608
2 changed files with 34 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

54
src/Physics/Classes/Collidible.hs
View file

@ -182,27 +182,37 @@ class (Show c, Mass c) => Collidible c where
NoCollision ->
if overlap
then
let xoverlap = floor (maximum (filter (0 >)
[ pm2b2x - pm2b1x
, pm2b1x - pm1b2x
]))
yoverlap = floor (maximum (filter (0 >)
[ pm2b1y - pm1b2y
, pm2b2y - pm1b1y
]))
let xoverlap = floor $ -- (maximum (filter (0 >)
-- [
pm2b2x - pm2b1x
-- , pm2b1x - pm1b2x
-- ]))
yoverlap = floor $ -- (maximum (filter (0 >)
-- [
pm2b1y - pm1b2y
-- , pm2b2y - pm1b1y
-- ]))
in
if xoverlap < yoverlap
then
if xoverlap < 0
then OverlapCollision
(V2 xoverlap 0)
else
case (xoverlap < 0, yoverlap < 0) of
(True, True) ->
if xoverlap < yoverlap
then
if xoverlap < 0
then OverlapCollision
(V2 xoverlap 0)
else
NoCollision
else
if yoverlap < 0
then OverlapCollision
(V2 0 yoverlap)
else NoCollision
(True, False) ->
OverlapCollision (V2 xoverlap 0)
(False, True) ->
OverlapCollision (V2 0 yoverlap)
(False, False) ->
NoCollision
else
if yoverlap < 0
then OverlapCollision
(V2 0 yoverlap)
else NoCollision
else NoCollision
_ -> A.log
A.Error
@ -255,8 +265,10 @@ elasticCollision damping mo1 (mo2, OverlapCollision depth) dt =
let m1 = mass mo1
m2 = mass mo2
(V2 dx dy) = (/ dt) . fromIntegral <$> depth
v1x' = 2 * (m1 * dx + m2 * (-dx)) / (m1 + m2) - dx
v1y' = 2 * (m1 * dy + m2 * (-dy)) / (m1 + m2) - dy
-- v1x' = 2 * (m1 * dx + m2 * (-dx)) / (m1 + m2) - dx
-- v1y' = 2 * (m1 * dy + m2 * (-dy)) / (m1 + m2) - dy
v1x' = 2 * (m1 * dx) / (m1 + m2)
v1y' = 2 * (m1 * dy) / (m1 + m2)
nvel = if m1 == recip 0
then V2 0 0
else (damping *) <$>

1
src/Types/Player.hs
View file

@ -174,6 +174,7 @@ instance Mass Pituicat where
move dt cat =
let dpos = (dt *) <$> velocity cat
mpos = (dt *) <$>
-- pcMoveVel cat
(if pcXColl cat then V2 (-1) 1 else V2 1 1) * pcMoveVel cat
in
positionUpdater cat (position cat + dpos + mpos)