pituicat/src/Physics/Classes/Collidible.hs

137 lines
4.6 KiB
Haskell

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
module Physics.Classes.Collidible where
import Affection as A
import Linear
-- internal imports
import Physics.Classes.Mass
data CollisionResult 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
-- | Update the collision occurence flag
updateCollisionOccurence :: c -> (Bool -> c)
-- | 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 (V2 Double) -- ^ Do the objects collide?
collisionCheck m1 m2 =
let (V2 p1x p1y) = position m1
(V2 p2x p2y) = position m2
(V2 b1minx b1miny, V2 b1maxx b1maxy) = boundary m1
(V2 b2minx b2miny, V2 b2maxx b2maxy) = boundary m2
getCoordinates
| p1x <= p2x && p1y <= p2y =
let x1 = p1x + b1maxx
y1 = p1y + b1maxy
x2 = p2x + b2minx
y2 = p2y + b2minx
in (x1, y1, x2, y2)
| p1x > p2x && p1y <= p2y =
let x1 = p1x + b1minx
y1 = p1y + b1maxy
x2 = p2x + b2maxx
y2 = p2y + b2miny
in (x1, y1, x2, y2)
| p1x <= p2x && p1y > p2y =
let x1 = p1x + b1maxx
y1 = p1y + b1miny
x2 = p2x + b2minx
y2 = p2y + b2maxy
in (x1, y1, x2, y2)
| otherwise =
let x1 = p1x + b1minx
y1 = p1y + b1miny
x2 = p2x + b2maxx
y2 = p2y + b2maxy
in (x1, y1, x2, y2)
(ox1, oy1, ox2, oy2) = getCoordinates
in
if ox2 - ox1 < 0 || oy2 - oy1 < 0
then OverlapCollision
(V2
(min 0 (ox2 - ox1) * (- 1))
(min 0 (oy2 - oy1) * (- 1))
)
else
NoCollision
-- | This Function is called for every collision on both colliding objects.
collide
:: (Collidible other)
=> c -- ^ Original object
-> [(other, CollisionResult (V2 Double))] -- ^ Collision partners and results
-> Double -- ^ Timestep length
-> c -- ^ Updated original object
collide coll1 collrs dt =
foldl (\acc a -> elasticCollision 0.9 acc a dt) coll1 collrs
-- | Implementation of a dampened elastic collision used as default collision
-- implementation of the collision reaction
elasticCollision
:: (Collidible c1, Collidible c2)
=> Double -- ^ Restitution coefficient
-> c1 -- ^ First collision partner
-> (c2, CollisionResult (V2 Double)) -- ^ Second collision partner with collision result
-> Double -- ^ Timestep length
-> c1 -- ^ Updated first collision partner
elasticCollision _ mo1 (_, NoCollision) _ = mo1
elasticCollision restitution mo1 (mo2, OverlapCollision depth) dt =
let dvel = (velocity mo1 - velocity mo2) * normalize depth
j = (restitution + 1) * (- (dvel `dot` dvel)) /
(1 / mass mo1 + 1 / mass mo2)
fi = (* (j / dt)) <$> normalize depth
in
positionUpdater (addImpactForce (updateCollisionOccurence mo1 True) fi)
(position mo1 - depth)