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