pituicat/src/Physics/Classes/Collidible.hs

137 lines
4.1 KiB
Haskell

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
module Physics.Classes.Collidible where
import Affection as A
import Linear
import Data.String (fromString)
import Data.List (sortBy)
-- internal imports
import Physics.Classes.Mass
data CollisionResult time direction
= NoCollision
| CollisionImminent
{ collisionTime :: time
, collisionDirection :: direction
}
| OverlapCollision
{ collisionDepth :: direction
}
deriving (Show, Eq)
-- | Typeclass for implementing collision results on objects.
class (Show c, Mass c) => Collidible c where
-- | 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
-- | 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.
boundary
:: c -- ^ Object
-> ( V2 Double
, V2 Double
) -- ^ Bottom left and top right corner of AABB relative to position
collisionCheck
:: (Collidible other)
=> c -- ^ First object
-> other -- ^ second object
-> CollisionResult Double (V2 Int) -- ^ Do the objects collide?
collisionCheck m1 m2 =
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!"
-- | This Function is called for every collision on both colliding objects.
collide
:: (Collidible other)
=> 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)
-- | Implementation of a dampened elastic collision used as default collision
-- implementation of the collision reaction
elasticCollision
:: (Collidible c1, Collidible c2)
=> Double
-> c1
-> (c2, CollisionResult Double (V2 Int))
-> Double -- ^ Timestep length
-> c1
elasticCollision _ mo1 (_, NoCollision) _ = mo1
elasticCollision damping mo1 (mo2, CollisionImminent ddt (V2 dirx diry)) dt =
let v1@(V2 v1x v1y) = velocity mo1
(V2 v2x v2y) = velocity mo2
p1 = position mo1
m1 = mass mo1
m2 = mass mo2
v1x' = 2 * (m1 * v1x + m2 * v2x) / (m1 + m2) - v1x
v1y' = 2 * (m1 * v1y + m2 * v2y) / (m1 + m2) - v1y
nvel = if m1 == recip 0
then V2 0 0
else (damping *) <$>
if m2 == recip 0
then
if dirx /= 0
then V2 (-v1x) v1y
else V2 v1x (-v1y)
else V2 v1x' v1y'
in
velocityUpdater
mo1
nvel
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
else (damping *) <$>
if m2 == recip 0
then
if dx /= 0
then V2 (-v1x') v1y'
else V2 v1x' (-v1y')
else
V2 v1x' v1y'
in
velocityUpdater mo1 nvel