2021-01-02 12:32:20 +00:00
|
|
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
2021-01-19 20:46:07 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2021-04-29 18:28:52 +00:00
|
|
|
module Physics.Classes.Collidible where
|
2020-12-27 04:19:51 +00:00
|
|
|
|
2021-01-19 20:46:07 +00:00
|
|
|
import Affection as A
|
|
|
|
|
2020-12-27 04:19:51 +00:00
|
|
|
import Linear
|
|
|
|
|
2021-01-19 20:46:07 +00:00
|
|
|
import Data.String (fromString)
|
|
|
|
|
2021-07-25 13:51:42 +00:00
|
|
|
import Data.List (sortBy)
|
|
|
|
|
2020-12-27 04:30:57 +00:00
|
|
|
-- internal imports
|
|
|
|
|
2021-04-29 18:28:52 +00:00
|
|
|
import Physics.Classes.Mass
|
2020-12-27 04:30:57 +00:00
|
|
|
|
2021-01-17 19:29:27 +00:00
|
|
|
data CollisionResult time direction
|
2021-01-17 01:30:45 +00:00
|
|
|
= NoCollision
|
2021-07-25 13:51:42 +00:00
|
|
|
| CollisionImminent
|
2021-02-27 15:08:45 +00:00
|
|
|
{ collisionTime :: time
|
|
|
|
, collisionDirection :: direction
|
|
|
|
}
|
2021-07-25 13:51:42 +00:00
|
|
|
| OverlapCollision
|
|
|
|
{ collisionDepth :: direction
|
|
|
|
}
|
2021-01-17 01:30:45 +00:00
|
|
|
deriving (Show, Eq)
|
|
|
|
|
2020-12-27 04:19:51 +00:00
|
|
|
-- | Typeclass for implementing collision results on objects.
|
2021-01-02 12:32:20 +00:00
|
|
|
class (Show c, Mass c) => Collidible c where
|
2020-12-27 04:19:51 +00:00
|
|
|
|
2021-08-30 04:04:06 +00:00
|
|
|
-- | Final position of the object in the previous timestep
|
|
|
|
prevPosition :: c -> V2 Double
|
|
|
|
|
|
|
|
-- | Aggregated impact forces in a simulation step
|
|
|
|
impactForces :: c -> V2 Double
|
|
|
|
|
|
|
|
-- | Overwrite the impact forces of the mass object
|
|
|
|
impactForcesUpdater :: c -> (V2 Double -> c)
|
|
|
|
|
|
|
|
-- | reset impact forces vector at the beginning of a simulation step
|
|
|
|
resetImpactForces :: c -> c
|
|
|
|
resetImpactForces c = impactForcesUpdater c (V2 0 0)
|
|
|
|
|
|
|
|
-- | Add a impact force to the impact forces acting on the mass object
|
|
|
|
addImpactForce
|
|
|
|
:: c
|
|
|
|
-> V2 Double
|
|
|
|
-> c
|
|
|
|
addImpactForce c force =
|
|
|
|
impactForcesUpdater c (impactForces c + force)
|
|
|
|
|
|
|
|
-- | Flag indicating a collision during the current time step
|
|
|
|
collisionOccured :: c -> Bool
|
|
|
|
|
2021-01-02 12:32:20 +00:00
|
|
|
-- | returns the bottom left and top right corners relative to the objects
|
|
|
|
-- positional vector of the axis aligned bounding box (AABB) serving here
|
|
|
|
-- as collision boundaries.
|
2020-12-27 04:19:51 +00:00
|
|
|
boundary
|
2021-01-02 12:32:20 +00:00
|
|
|
:: c -- ^ Object
|
2021-07-09 17:49:09 +00:00
|
|
|
-> ( V2 Double
|
|
|
|
, V2 Double
|
|
|
|
) -- ^ Bottom left and top right corner of AABB relative to position
|
2021-01-02 12:32:20 +00:00
|
|
|
|
|
|
|
collisionCheck
|
|
|
|
:: (Collidible other)
|
2021-08-30 04:04:06 +00:00
|
|
|
=> c -- ^ First object
|
2021-01-17 19:29:27 +00:00
|
|
|
-> other -- ^ second object
|
|
|
|
-> CollisionResult Double (V2 Int) -- ^ Do the objects collide?
|
2021-08-30 04:04:06 +00:00
|
|
|
collisionCheck m1 m2 =
|
2021-08-31 00:15:33 +00:00
|
|
|
let p1@(V2 p1x p1y) = position m1
|
|
|
|
p2@(V2 p2x p2y) = position m2
|
|
|
|
v1@(V2 v1x v1y) = velocity m1
|
|
|
|
v2@(V2 v2x v2y) = velocity m2
|
|
|
|
(V2 dvx dvy) = v1 - v2
|
|
|
|
(V2 dx dy) = p1 - p2
|
|
|
|
in
|
|
|
|
error "collisionCheck: Not yet implemented!"
|
2021-01-02 12:32:20 +00:00
|
|
|
|
|
|
|
-- | This Function is called for every collision on both colliding objects.
|
2020-12-27 04:19:51 +00:00
|
|
|
collide
|
2021-01-02 12:32:20 +00:00
|
|
|
:: (Collidible other)
|
2021-07-24 07:35:41 +00:00
|
|
|
=> c -- ^ Original object
|
|
|
|
-> [(other, CollisionResult Double (V2 Int))] -- ^ Collision partners and results
|
|
|
|
-> Double -- ^ Timestep length
|
|
|
|
-> c -- ^ Updated original object
|
|
|
|
collide coll1 collrs = elasticCollision 0.9 coll1 (head collrs)
|
2021-01-02 12:32:20 +00:00
|
|
|
|
|
|
|
-- | Implementation of a dampened elastic collision used as default collision
|
|
|
|
-- implementation of the collision reaction
|
|
|
|
elasticCollision
|
|
|
|
:: (Collidible c1, Collidible c2)
|
|
|
|
=> Double
|
|
|
|
-> c1
|
2021-07-24 07:35:41 +00:00
|
|
|
-> (c2, CollisionResult Double (V2 Int))
|
|
|
|
-> Double -- ^ Timestep length
|
2021-01-02 12:32:20 +00:00
|
|
|
-> c1
|
2021-07-24 07:35:41 +00:00
|
|
|
elasticCollision _ mo1 (_, NoCollision) _ = mo1
|
2021-07-25 13:51:42 +00:00
|
|
|
elasticCollision damping mo1 (mo2, CollisionImminent ddt (V2 dirx diry)) dt =
|
2021-01-17 01:30:45 +00:00
|
|
|
let v1@(V2 v1x v1y) = velocity mo1
|
2021-01-02 12:32:20 +00:00
|
|
|
(V2 v2x v2y) = velocity mo2
|
2021-04-17 02:53:21 +00:00
|
|
|
p1 = position mo1
|
2021-01-02 12:32:20 +00:00
|
|
|
m1 = mass mo1
|
|
|
|
m2 = mass mo2
|
|
|
|
v1x' = 2 * (m1 * v1x + m2 * v2x) / (m1 + m2) - v1x
|
|
|
|
v1y' = 2 * (m1 * v1y + m2 * v2y) / (m1 + m2) - v1y
|
2021-04-17 02:53:21 +00:00
|
|
|
nvel = if m1 == recip 0
|
2021-01-02 12:32:20 +00:00
|
|
|
then V2 0 0
|
|
|
|
else (damping *) <$>
|
|
|
|
if m2 == recip 0
|
2021-01-14 22:08:24 +00:00
|
|
|
then
|
2021-07-08 16:39:31 +00:00
|
|
|
if dirx /= 0
|
2021-07-09 17:49:09 +00:00
|
|
|
then V2 (-v1x) v1y
|
|
|
|
else V2 v1x (-v1y)
|
|
|
|
else V2 v1x' v1y'
|
2021-01-14 22:08:24 +00:00
|
|
|
in
|
2021-07-09 17:49:09 +00:00
|
|
|
velocityUpdater
|
2021-07-24 07:35:41 +00:00
|
|
|
mo1
|
|
|
|
nvel
|
2021-07-25 13:51:42 +00:00
|
|
|
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
|
|
|
|
nvel = if m1 == recip 0
|
|
|
|
then V2 0 0
|
2021-07-25 14:14:05 +00:00
|
|
|
else (damping *) <$>
|
|
|
|
if m2 == recip 0
|
|
|
|
then
|
|
|
|
if dx /= 0
|
|
|
|
then V2 (-v1x') v1y'
|
|
|
|
else V2 v1x' (-v1y')
|
|
|
|
else
|
|
|
|
V2 v1x' v1y'
|
2021-07-25 13:51:42 +00:00
|
|
|
in
|
|
|
|
velocityUpdater mo1 nvel
|