Refined collision detection player vs entity

1 files changed, 38 insertions, 19 deletions

diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs
index 0860d49..d0ef4eb 100644
--- a/src/Game/Entities.hs
+++ b/src/Game/Entities.hs
@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-
 module Game.Entities (Entities, Entity, mkEntities, updateAll, render) where
 
 import Data.Foldable (find, traverse_)
@@ -63,24 +61,32 @@ data Entity = Entity
     spawns :: [Spawn]
   }
 
+-- | Returns the number of frames available on the entity's sprite for current direction.
 frameLimit :: Entity -> Int
 frameLimit e = S.frameCount e.sprite (toSpriteSet e.dir)
 
-collision :: Entity -> Entity -> Bool
-collision player other =
-  player.x + 4 < other.x + 12
-    && other.x + 4 < player.x + 12
-    && player.y + 12 < other.y + 16
-    && other.y + 4 < player.y + 24
+type Collision = Entity -> IO Bool
+
+-- | Collision detection of player vs entity.
+--
+-- The player's head won't register, this is necessary to avoid hitting things on a platform above when jumping.
+collision :: IORef Entity -> Collision
+collision playerRef other = do
+  player <- readIORef playerRef
+  pure $
+    player.x + 4 < other.x + 12
+      && other.x + 4 < player.x + 12
+      && player.y + 12 < other.y + 16
+      && other.y + 4 < player.y + 24
 
 mkEntities :: S.SpriteSheet -> M.Map -> IORef C.Controls -> IO Entities
 mkEntities sprites m controls = do
   player <- case find isPlayer (M.objects m) of
     Just (M.PlayerEntity x y) -> mkPlayer sprites x y controls (M.isBlocked m)
     _ -> error "No player entity in map"
-  -- XXX
   playerRef <- newIORef player
   entities <- traverse (toEntity playerRef) $ filter (not . isPlayer) (M.objects m)
+  -- the entities list has always player first
   pure $ Entities sprites playerRef (player : entities)
   where
     toEntity :: IORef Entity -> M.Object -> IO Entity
@@ -96,16 +102,28 @@ processSpawn sprites (DustEffectSpawn x y) = mkEffect sprites x y "dust"
 
 updateAll :: Entities -> IO Entities
 updateAll es = do
-  updated <- traverse (\e -> e.update e) es.entities
-  -- XXX
-  _ <- writeIORef es.player $ head updated
+  -- update the player first (including the reference)
+  updatedPlayer <- player.update player
+  _ <- writeIORef es.player updatedPlayer
+  -- then the other entities
+  updated <- (updatedPlayer :) <$> traverse (\e -> e.update e) others
+  -- collect new entities
   new <- traverse (processSpawn es.sprites) (concatMap (\e -> e.spawns) updated)
+  -- clear spawns (new entities), filter out destroyed entities, and add the new ones
   pure es {entities = map (\e -> e {spawns = []}) (filter (\e -> not e.destroy) updated) ++ new}
+  where
+    player = head es.entities
+    others = tail es.entities
 
 render :: SDL.Renderer -> Entities -> IO ()
 render renderer es = do
-  traverse_ renderOne (reverse es.entities)
+  -- always render player last
+  traverse_ renderOne others
+  renderOne player
   where
+    player = head es.entities
+    others = tail es.entities
+
     renderOne :: Entity -> IO ()
     renderOne e =
       S.render renderer e.sprite e.x e.y set e.frame
@@ -151,16 +169,17 @@ mkBattery sprites x y playerRef = do
         gravity = gravityOff,
         dir = DirRight,
         sprite = s,
-        update = updateBattery playerRef,
+        update = updateBattery (collision playerRef),
         destroy = False,
         spawns = []
       }
 
-updateBattery :: IORef Entity -> Entity -> IO Entity
-updateBattery playerRef e = do
-  player <- readIORef playerRef
-  if collision player e then pure e {destroy = True} else pure updateBatteryFrame
+updateBattery :: Collision -> Entity -> IO Entity
+updateBattery touchedPlayer e = do
+  -- XXX: how do we update game state? :thinkingface:
+  (\t -> if t then e {destroy = True} else updateBatteryFrame) <$> touchedPlayer e
   where
+    updateBatteryFrame :: Entity
     updateBatteryFrame
       | e.delay > 0 = e {delay = e.delay - 1}
       | e.frame + 1 < frameLimit e = e {delay = frameDelay, frame = e.frame + 1}
@@ -196,7 +215,7 @@ updateFrame updated e
 
 updateHorizontal :: IsBlocked -> Bool -> Bool -> Entity -> Entity
 updateHorizontal isBlocked left right e
-  -- prevent pressing both directions (kyboard)
+  -- prevent pressing both directions (keyboard)
   | left && right = e
   -- change direction first
   | left && e.dir /= DirLeft = e {dir = DirLeft, delay = 0}