haskanoid-0.1.6: src/GameCollisions.hs

-- |
-- Copyright  : (c) Ivan Perez & Henrik Nilsson, 2014.
-- License    : See LICENSE file.
-- Maintainer : Ivan Perez <ivan.perez@keera.co.uk>
--
-- A very rudimentary collision system.
--
-- It compares every pair of objects, trying to determine if there is a
-- collision between the two of them.
--
-- NOTE: In order to minimize the number of comparisons, only moving objects
-- are tested (against every game object). That's only 2 objects right now
-- (making it almost linear in complexity), but it could easily grow and become
-- too slow.
--
module GameCollisions where

-- External imports
import Data.List
import Data.Maybe

-- Internal imports
import Data.IdentityList
import Objects
import Physics.TwoDimensions.Dimensions

-- | Given a list of objects, it detects all the collisions between them.
--
-- Note: this is a simple n*m-complex algorithm, with n the number of objects
-- and m the number of moving objects (right now, only 2).
--
detectCollisions :: IL Object -> Collisions
detectCollisions = detectCollisionsH
  where
    detectCollisionsH objsT = flattened
      where
        -- Eliminate empty collision sets
        -- TODO: why is this really necessary?
        flattened = filter (\(Collision n) -> not (null n)) collisions

        -- Detect collisions between moving objects and any other objects
        collisions = detectCollisions' objsT moving

        -- Partition the object space between moving and static objects
        (moving, _static) = partition (canCauseCollisions.snd) $ assocsIL objsT

-- | Detect collisions between each moving object and every other object.
detectCollisions' :: IL Object -> [(ILKey, Object)] -> [Collision]
detectCollisions' objsT ms = concatMap (detectCollisions'' objsT) ms

-- | Detect collisions between one specific moving object and every existing
-- object. Each collision is independent of the rest (which is not necessarily
-- what should happen, but since the transformed velocities are eventually
-- added, there isn't much difference in the end).
detectCollisions'' :: IL Object -> (ILKey, Object) -> [Collision]
detectCollisions'' objsT m = concatMap (detectCollisions''' m) (assocsIL objsT)

-- | Detect a possible collision between two objects. Uses the object's keys to
-- distinguish them. Uses the basic 'Object'-based 'detectCollision' to
-- determine whether the two objects do collide.
detectCollisions''' :: (ILKey, Object) -> (ILKey, Object) -> [Collision]
detectCollisions''' m o
  | fst m == fst o = []    -- Same object -> no collision
  | otherwise      = maybeToList (detectCollision (snd m) (snd o))

-- | Return the new velocity as changed by the collection of collisions.
--
-- HN 2014-09-07: New interface to collision detection.
--
-- The assumption is that collision detection happens globally and that the
-- changed velocity is figured out for each object involved in a collision
-- based on the properties of all objects involved in any specific interaction.
-- That may not be how it works now, but the interface means it could work that
-- way. Even more physical might be to figure out the impulsive force acting on
-- each object.
--
-- However, the whole collision infrastructure should be revisited.
--
-- - Statefulness ("edge") might make it more robust.
--
-- - Think through how collision events are going to be communicated to the
--   objects themselves. Maybe an input event is the natural thing to do.
--   Except then we have to be careful to avoid switching again immediately
--   after one switch.
--
-- - Should try to avoid n^2 checks. Maybe some kind of quad-trees?  Maybe
--   spawning a stateful collision detector when two objects are getting close?
--   Cf. the old tail-gating approach.
-- - Maybe a collision should also carry the identity of the object one
--   collided with to facilitate impl. of "inCollisionWith".
--
changedVelocity :: ObjectName -> Collisions -> Maybe Vel2D
changedVelocity name cs =
  case concatMap (filter ((== name) . fst) . collisionData) cs of
    []          -> Nothing
    (_, v') : _ -> Just v'

    -- IP: It should be something like the following, but that doesn't work:
    -- vs -> Just (foldl (^+^) (0, 0) (map snd vs))

-- | True if the velocity of the object has been changed by any collision.
inCollision :: ObjectName -> Collisions -> Bool
inCollision name cs = isJust (changedVelocity name cs)

-- | True if the two objects are colliding with one another.
inCollisionWith :: ObjectName -> ObjectName -> Collisions -> Bool
inCollisionWith nm1 nm2 cs = any (both nm1 nm2) cs
  where
    both nm1 nm2 (Collision nmvs) =
      any ((== nm1) . fst) nmvs
      && any ((== nm2) . fst) nmvs