{-# 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)