From 5841bb26769f28b99808c142e47eb128c161b6c8 Mon Sep 17 00:00:00 2001
From: "Juan J. Martinez" <jjm@usebox.net>
Date: Mon, 13 Feb 2023 22:04:37 +0000
Subject: Refined collision

---
 src/Game/Entities.hs | 35 +++++++++++++++++------------------
 1 file changed, 17 insertions(+), 18 deletions(-)

(limited to 'src/Game')

diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs
index ebb73d0..dad7fb7 100644
--- a/src/Game/Entities.hs
+++ b/src/Game/Entities.hs
@@ -38,13 +38,12 @@ jumpLimit = gravityDown + 7
 gravityTable :: [Int]
 gravityTable = [0, 6, 4, 4, 2, 2, 2, 2, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 2, 2, 2, 2, 4]
 
-type MapCollision = Int -> Int -> Bool
+type IsBlocked = Int -> Int -> Bool
 
 data Entities = Entities
   { sprites :: S.SpriteSheet,
     player :: IORef Entity,
-    entities :: [Entity],
-    mapCollision :: MapCollision
+    entities :: [Entity]
   }
 
 data Spawn = DustEffectSpawn Int Int
@@ -59,7 +58,7 @@ data Entity = Entity
     gravity :: Int,
     dir :: Dir,
     sprite :: S.Sprite,
-    update :: Entity -> MapCollision -> IO Entity,
+    update :: Entity -> IO Entity,
     destroy :: Bool,
     spawns :: [Spawn]
   }
@@ -73,10 +72,10 @@ mkEntities sprites m controls = do
   player <- case find isPlayer entities of
     Just player -> newIORef player
     Nothing -> error "No player entity in map"
-  pure $ Entities sprites player entities (M.isBlocked m)
+  pure $ Entities sprites player entities
   where
     toEntity :: M.Object -> IO Entity
-    toEntity (M.PlayerEntity x y) = mkPlayer sprites x y controls
+    toEntity (M.PlayerEntity x y) = mkPlayer sprites x y controls (M.isBlocked m)
     toEntity (M.BatteryEntity x y) = mkBattery sprites x y
 
     isPlayer :: Entity -> Bool
@@ -89,7 +88,7 @@ processSpawn sprites (DustEffectSpawn x y) = mkEffect sprites x y "dust"
 
 updateAll :: Entities -> IO Entities
 updateAll es = do
-  updated <- traverse (\e -> e.update e es.mapCollision) es.entities
+  updated <- traverse (\e -> e.update e) es.entities
   new <- traverse (processSpawn es.sprites) (concatMap (\e -> e.spawns) updated)
   pure es {entities = map (\e -> e {spawns = []}) (filter (\e -> not e.destroy) updated) ++ new}
 
@@ -117,7 +116,7 @@ mkEffect sprites x y name = do
         gravity = gravityOff,
         dir = DirRight,
         sprite = s,
-        update = \e _ -> pure $ updateEffect e,
+        update = pure . updateEffect,
         destroy = False,
         spawns = []
       }
@@ -142,7 +141,7 @@ mkBattery sprites x y = do
         gravity = gravityOff,
         dir = DirRight,
         sprite = s,
-        update = \e _ -> pure $ updateBattery e,
+        update = pure . updateBattery,
         destroy = False,
         spawns = []
       }
@@ -153,8 +152,8 @@ updateBattery e
   | e.frame + 1 < frameLimit e = e {delay = frameDelay, frame = e.frame + 1}
   | otherwise = e {delay = frameDelay, frame = 0}
 
-mkPlayer :: S.SpriteSheet -> Int -> Int -> IORef C.Controls -> IO Entity
-mkPlayer sprites x y controls = do
+mkPlayer :: S.SpriteSheet -> Int -> Int -> IORef C.Controls -> IsBlocked -> IO Entity
+mkPlayer sprites x y controls isBlocked = do
   s <- S.get sprites "player"
   pure $
     Entity
@@ -167,7 +166,7 @@ mkPlayer sprites x y controls = do
         gravity = gravityOff,
         dir = DirRight,
         sprite = s,
-        update = updatePlayer controls,
+        update = updatePlayer controls isBlocked,
         destroy = False,
         spawns = []
       }
@@ -181,7 +180,7 @@ updateFrame updated e
   where
     isGravityOn = e.gravity > gravityOff
 
-updateHorizontal :: MapCollision -> Bool -> Bool -> Entity -> Entity
+updateHorizontal :: IsBlocked -> Bool -> Bool -> Entity -> Entity
 updateHorizontal isBlocked left right e
   -- prevent pressing both directions (kyboard)
   | left && right = e
@@ -196,7 +195,7 @@ updateHorizontal isBlocked left right e
   where
     isGoingDown = e.gravity == gravityOff || e.gravity >= gravityDown
 
-updateVertical :: MapCollision -> Bool -> Bool -> Entity -> Entity
+updateVertical :: IsBlocked -> Bool -> Bool -> Entity -> Entity
 updateVertical isBlocked jump down e
   | not jump
       || e.jumping
@@ -212,7 +211,7 @@ updateVertical isBlocked jump down e
       e {gravity = gravityDown, frame = jumpFrame, y = e.y + 1}
   | otherwise = e
 
-applyGravity :: MapCollision -> Int -> Entity -> Entity
+applyGravity :: IsBlocked -> Int -> Entity -> Entity
 applyGravity isBlocked v e
   | v == 0 = e
   -- hit the floor
@@ -226,7 +225,7 @@ applyGravity isBlocked v e
     isGoingDown = e.gravity >= gravityDown
     change = if isGoingDown then 1 else -1
 
-updateGravity :: MapCollision -> Entity -> Entity
+updateGravity :: IsBlocked -> Entity -> Entity
 updateGravity isBlocked e
   | current > gravityOff = applyGravity isBlocked (gravityTable !! current) e {gravity = new}
   | not (isBlocked (e.x + 2) (e.y + 24) || isBlocked (e.x + 12) (e.y + 24)) = e {gravity = gravityDown, frame = jumpFrame}
@@ -235,8 +234,8 @@ updateGravity isBlocked e
     current = e.gravity
     new = if current > gravityOff && current < length gravityTable - 1 then current + 1 else current
 
-updatePlayer :: IORef C.Controls -> Entity -> MapCollision -> IO Entity
-updatePlayer controls e isBlocked = do
+updatePlayer :: IORef C.Controls -> IsBlocked -> Entity -> IO Entity
+updatePlayer controls isBlocked e = do
   ctl <- readIORef controls
   pure $
     updateGravity isBlocked $
-- 
cgit v1.2.3