integrate collision detection into game logic

fixed logical erros and cleaned up hitbox handling on the way.

3 files changed, 25 insertions, 12 deletions

diff --git a/README.md b/README.md
index 57adba1..eb124c8 100644
--- a/README.md
+++ b/README.md
@@ -16,7 +16,7 @@ the most realistic asteroids-like game in existence.
 
 - [x] simulation of gravity
 - [x] controllable spaceship
-- [ ] collision detection
+- [x] collision detection
 - [ ] make measurements more realistic
 - [ ] allow for zooming the viewport
 - [ ] time scaling / fast forward
diff --git a/lib/Grav2ty/Simulation.hs b/lib/Grav2ty/Simulation.hs
index 39e2883..06aa8de 100644
--- a/lib/Grav2ty/Simulation.hs
+++ b/lib/Grav2ty/Simulation.hs
@@ -3,6 +3,8 @@ module Grav2ty.Simulation
   -- * Objects
     Object (..)
   , Modifier (..)
+  , realHitbox
+  , isDynamic
   , World (..)
   , updateObject
   , gravitationForces
@@ -63,6 +65,12 @@ rotateHitbox angle box =
   where rotator = cos angle :+ sin angle
         rotate = (^. complexV2) . (* rotator) . (^. from complexV2)
 
+-- | Returns the 'Hitbox' for an 'Object', but rotated and translated
+--   to the location it is *actually* at.
+realHitbox :: RealFloat a => Object a -> Hitbox a
+realHitbox obj = translateHitbox (objectLoc obj) . rotateHitbox (objectRot obj)
+  . objectHitbox $ obj
+
 -- | Implementation of
 --   [Cramer's rule](https://en.wikipedia.org/wiki/Cramer%27s_rule) for solving
 --   a system of two linear equations.
@@ -130,9 +138,9 @@ collision (HLine a1 b1) (HLine a2 b2) =
 collision (HCombined as) b = any (collision b) as
 collision a b@(HCombined _) = collision b a
 
-collisionWithWorld :: (Ord a, Floating a) => World a -> Object a -> Bool
-collisionWithWorld world obj =
-  any (collision (objectHitbox obj) . objectHitbox) world
+collisionWithWorld :: (Ord a, RealFloat a) => World a -> Object a -> Bool
+collisionWithWorld world obj = any (\obj' ->
+  obj /= obj' && collision (realHitbox obj) (realHitbox obj')) world
 
 data Modifier
   = NoMod
@@ -162,6 +170,10 @@ data Object a
   , objectLoc    :: V2 a     -- ^ See above.
   } deriving (Show, Eq, Ord)
 
+isDynamic :: Object a -> Bool
+isDynamic Dynamic {} = True
+isDynamic _ = False
+
 type World a = [Object a]
 
 separated :: (Floating a, Ord a) => Object a -> Object a -> Bool
diff --git a/src/Main.hs b/src/Main.hs
index b4e4742..042b7bc 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -6,7 +6,6 @@ import Grav2ty.Control
 import Linear.V2
 import Data.Maybe
 import Data.Tuple (uncurry)
-import Debug.Trace
 import qualified Data.Map as Map
 
 import Graphics.Gloss
@@ -34,11 +33,7 @@ renderHitbox box =  Color white $
     HCombined boxes -> Pictures $ map renderHitbox boxes
 
 renderObject :: Object Float -> Picture
-renderObject obj = renderHitbox . translate . rot . objectHitbox $ obj
-  where translate = translateHitbox (objectLoc obj)
-        rot       = rotateHitbox (objectRot obj)
-        toDegree  = (*) (360 / (2 * pi))
-        clockwise = (*) (-1)
+renderObject obj = renderHitbox . realHitbox $ obj
 
 renderUi :: (Show a, Num a) => State a GlossState -> Picture
 renderUi state = (uncurry translate) (tupleMap ((+ 50) . (* (-1)) . (/ 2) . fromIntegral)
@@ -78,10 +73,16 @@ eventHandler (EventResize vp) state = state
   { graphics = (graphics state) { glossViewPort = vp } }
 eventHandler _ s = s
 
+-- TODO make code more generic and move to Grav2ty.Simulation
 updateWorld :: Float -> State Float GlossState -> State Float GlossState
 updateWorld timeStep (State ctrl g world) = State ctrl
-  (g { glossViewPortCenter = fromMaybe (0, 0) center }) newWorld
-  where (newWorld, center) = updateAndExtract world extractCenter ([], Nothing)
+  (g { glossViewPortCenter = fromMaybe (0, 0) center }) uncollidedWorld
+  where uncollidedWorld = foldl collideFolder [] newWorld
+        collideFolder res obj =
+          if isDynamic obj && collisionWithWorld newWorld obj
+             then res
+             else obj : res
+        (newWorld, center) = updateAndExtract world extractCenter ([], Nothing)
         extractCenter :: Object Float -> Maybe (Float, Float)
                       -> Maybe (Float, Float)
         extractCenter o@(Dynamic { objectMod = LocalMod }) _ =