{-# LANGUAGE AllowAmbiguousTypes #-} module Classes.Physics.Collidible where import Linear -- internal imports import Classes.Physics.Mass -- | Typeclass for implementing collision results on objects. class (Show c, Mass c) => Collidible c where -- | 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 -- ^ Bottom left corner of AABB relative to position , V2 Double -- ^ Top right corner of AABB relative to position ) collisionCheck :: (Collidible other) => Double -- Time step length -> c -- ^ First object -> other -- ^ second object -> Bool -- ^ Do the objects collide? collisionCheck dt m1 m2 = let (V2 m1x1 m1y1) = position m1 + fst (boundary m1) + delta1 (V2 m1x2 m1y2) = position m1 + snd (boundary m1) + delta1 (V2 m2x1 m2y1) = position m2 + fst (boundary m2) + delta2 (V2 m2x2 m2y2) = position m2 + snd (boundary m2) + delta2 delta1@(V2 vx1 vy1) = (dt *) <$> velocity m1 delta2@(V2 vx2 vy2) = (dt *) <$> velocity m2 dtx 0 = dt dtx vx = if vx1 > 0 then (m2x1 - m1x2) / vx else (m1x1 - m2x2) / (-vx) dty 0 = dt dty vy = if vy1 > 0 then (m2y1 - m1y2) / vy else (m1y1 - m2y2) / (-vy) posColl = or [ m1x1 < m2x2 && m1x1 > m2x1 , m1x2 < m2x2 && m1x2 > m2x1 , m2x1 < m1x2 && m2x1 > m1x1 , m2x2 < m1x2 && m2x2 > m1x1 ] && or [ m1y1 < m2y2 && m1y1 > m2y1 , m1y2 < m2y2 && m1y2 > m2y1 , m2y1 < m1y2 && m2y1 > m1y1 , m2y2 < m1y2 && m2y2 > m1y1 ] in (if vx1 == 0 then posColl else dt > dtx vx1) && (if vy1 == 0 then posColl else dt > dty vy1) -- | This Function is called for every collision on both colliding objects. collide :: (Collidible other) => c -- ^ Original object -> other -- ^ Collision partner -> c -- ^ Updated original object collide = elasticCollision 0.9 -- | Implementation of a dampened elastic collision used as default collision -- implementation of the collision reaction elasticCollision :: (Collidible c1, Collidible c2) => Double -> c1 -> c2 -> c1 elasticCollision damping mo1 mo2 = let (V2 v1x v1y) = velocity mo1 (V2 v2x v2y) = velocity mo2 m1 = mass mo1 m2 = mass mo2 v1x' = 2 * (m1 * v1x + m2 * v2x) / (m1 + m2) - v1x v1y' = 2 * (m1 * v1y + m2 * v2y) / (m1 + m2) - v1y in (velocityUpdater mo1) (if m1 == recip 0 then V2 0 0 else (damping *) <$> if m2 == recip 0 then negate <$> velocity mo1 else (V2 v1x' v1y') )