Experiment with entity vs player collision

1 files changed, 30 insertions, 20 deletions

diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs
index dad7fb7..dca8d01 100644
--- a/src/Game/Entities.hs
+++ b/src/Game/Entities.hs
@@ -66,22 +66,26 @@ data Entity = Entity
 frameLimit :: Entity -> Int
 frameLimit e = S.frameCount e.sprite (toSpriteSet e.dir)
 
+collision :: Entity -> Entity -> Bool
+collision a b = a.x < b.x + 16 && b.x < a.x + 16 && a.y < b.y + 16 && b.y < a.y + 16
+
 mkEntities :: S.SpriteSheet -> M.Map -> IORef C.Controls -> IO Entities
 mkEntities sprites m controls = do
-  entities <- traverse toEntity $ M.objects m
-  player <- case find isPlayer entities of
-    Just player -> newIORef player
-    Nothing -> error "No player entity in map"
-  pure $ Entities sprites player entities
+  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)
+  pure $ Entities sprites playerRef (player : entities)
   where
-    toEntity :: M.Object -> IO Entity
-    toEntity (M.PlayerEntity x y) = mkPlayer sprites x y controls (M.isBlocked m)
-    toEntity (M.BatteryEntity x y) = mkBattery sprites x y
+    toEntity :: IORef Entity -> M.Object -> IO Entity
+    toEntity playerRef (M.BatteryEntity x y) = mkBattery sprites x y playerRef
+    toEntity _ (M.PlayerEntity _ _) = error "Player already processed"
 
-    isPlayer :: Entity -> Bool
-    isPlayer e = case e.typ of
-      TypePlayer -> True
-      _ -> False
+    isPlayer :: M.Object -> Bool
+    isPlayer (M.PlayerEntity _ _) = True
+    isPlayer _ = False
 
 processSpawn :: S.SpriteSheet -> Spawn -> IO Entity
 processSpawn sprites (DustEffectSpawn x y) = mkEffect sprites x y "dust"
@@ -89,6 +93,8 @@ 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
   new <- traverse (processSpawn es.sprites) (concatMap (\e -> e.spawns) updated)
   pure es {entities = map (\e -> e {spawns = []}) (filter (\e -> not e.destroy) updated) ++ new}
 
@@ -127,8 +133,8 @@ updateEffect e
   | e.frame + 1 < frameLimit e = e {delay = frameDelay, frame = e.frame + 1}
   | otherwise = e {destroy = True}
 
-mkBattery :: S.SpriteSheet -> Int -> Int -> IO Entity
-mkBattery sprites x y = do
+mkBattery :: S.SpriteSheet -> Int -> Int -> IORef Entity -> IO Entity
+mkBattery sprites x y playerRef = do
   s <- S.get sprites "battery"
   pure $
     Entity
@@ -141,16 +147,20 @@ mkBattery sprites x y = do
         gravity = gravityOff,
         dir = DirRight,
         sprite = s,
-        update = pure . updateBattery,
+        update = updateBattery playerRef,
         destroy = False,
         spawns = []
       }
 
-updateBattery :: Entity -> Entity
-updateBattery e
-  | e.delay > 0 = e {delay = e.delay - 1}
-  | e.frame + 1 < frameLimit e = e {delay = frameDelay, frame = e.frame + 1}
-  | otherwise = e {delay = frameDelay, frame = 0}
+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
+  where
+    updateBatteryFrame
+      | e.delay > 0 = e {delay = e.delay - 1}
+      | 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 -> IsBlocked -> IO Entity
 mkPlayer sprites x y controls isBlocked = do