Revisited the game over sequence

7 files changed, 28 insertions, 39 deletions

diff --git a/data/sprites.json b/data/sprites.json
index 61c751e..bc9a930 100644
--- a/data/sprites.json
+++ b/data/sprites.json
@@ -12,11 +12,13 @@
             { "x": 32, "y": 0, "width": 16, "height": 24 },
             { "x": 48, "y": 0, "width": 16, "height": 24 },
             { "x": 64, "y": 0, "width": 16, "height": 24 },
-            { "x": 80, "y": 0, "width": 16, "height": 24 }
+            { "x": 80, "y": 0, "width": 16, "height": 24 },
+            { "x": 64, "y": 24, "width": 16, "height": 24 }
         ],
         "sets": [
             [0, 1, 0, 2],
-            [5, 4, 5, 3]
+            [5, 4, 5, 3],
+            [6]
         ]
     },
     "dust": {
diff --git a/data/sprites.png b/data/sprites.png
index b07c0f4..ee964db 100644
--- a/data/sprites.png
+++ b/data/sprites.png
diff --git a/src/Game.hs b/src/Game.hs
index 0b72f3c..a1f0e2a 100644
--- a/src/Game.hs
+++ b/src/Game.hs
@@ -8,7 +8,6 @@ import Foreign.C.Types (CInt)
 import qualified Game.BitmapFont as BF
 import qualified Game.Controller as C
 import qualified Game.Entities as E
-import Game.Entities.Const (gameOverDelay)
 import qualified Game.Hud as H
 import qualified Game.Map as M
 import qualified Game.Sprites as S
@@ -17,7 +16,7 @@ import qualified Game.Utils as U
 import SDL (($=), ($~))
 import qualified SDL
 import qualified SDL.Image
-import SDL.Vect (V2 (..), V4 (..))
+import SDL.Vect (V2 (..))
 
 name :: String
 name = "Haskell gamedev [Space Platformer]"
@@ -162,12 +161,9 @@ gameLoop = do
 
     void $ liftIO $ do
       state <- readIORef stateRef
-      if state.lives > 0
-        then playLoop env
-        else
-          if state.gameOverDelay > 0
-            then fadeOutLoop env state.gameOverDelay >> stateRef $= state {GS.gameOverDelay = state.gameOverDelay - 1}
-            else gameOverLoop env
+      when (state.gameOverDelay > 1) $ stateRef $= state {GS.gameOverDelay = state.gameOverDelay - 1}
+      when (state.gameOverDelay /= 1) $ playLoop env
+      when (state.gameOverDelay == 1) $ gameOverLoop env
 
     SDL.rendererRenderTarget renderer $= Nothing
     SDL.clear renderer
@@ -194,24 +190,6 @@ gameLoop = do
         H.render renderer hud
         E.render renderer updated
 
-    fadeOutLoop :: Env -> Int -> IO ()
-    fadeOutLoop env i = do
-      let renderer = env.renderer
-          map' = env.map
-          entities = env.entities
-          hud = env.hud
-
-      -- render map and entities
-      -- doing a fade to black
-      void $ do
-        M.render renderer map'
-        H.render renderer hud
-        E.render renderer =<< readIORef entities
-
-        SDL.rendererDrawBlendMode renderer $= SDL.BlendAlphaBlend
-        SDL.rendererDrawColor renderer $= V4 0 0 0 (fromIntegral (255 - i * (255 `div` gameOverDelay)))
-        SDL.fillRect renderer (Just $ U.rect 0 0 320 176)
-
     gameOverLoop :: Env -> IO ()
     gameOverLoop env = do
       let renderer = env.renderer
diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs
index 71f9791..a168e83 100644
--- a/src/Game/Entities.hs
+++ b/src/Game/Entities.hs
@@ -51,8 +51,12 @@ updateAll es = do
   updated <- (updatedPlayer :) <$> traverse (updateFilter playerWasHit) others
   -- collect new entities
   new <- traverse (processSpawn es.sprites) (concatMap (\e -> e.spawns) updated)
+  -- is the player dead?
+  updated' <- do
+    s <- readIORef es.state
+    pure $ if s.lives == 0 && updatedPlayer.dir /= Dying then (head updated) {dir = Dying, gravity = gravityUp} : tail updated else 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}
+  pure es {entities = map (\e -> e {spawns = []}) (filter (\e -> not e.destroy) updated') ++ new}
   where
     player = head es.entities
     others = tail es.entities
diff --git a/src/Game/Entities/Common.hs b/src/Game/Entities/Common.hs
index 251dbb4..ca5eb78 100644
--- a/src/Game/Entities/Common.hs
+++ b/src/Game/Entities/Common.hs
@@ -20,6 +20,8 @@ import SDL (($~))
 toSpriteSet :: Dir -> Int
 toSpriteSet DirRight = 0
 toSpriteSet DirLeft = 1
+-- not really a direction
+toSpriteSet Dying = 2
 
 -- | Return the number of frames available on the entity's sprite for current direction.
 frameLimit :: Entity -> Int
@@ -32,7 +34,8 @@ collision :: IORef Entity -> Int -> Collision
 collision playerRef otherHeight other = do
   player <- readIORef playerRef
   pure $
-    player.x + 4 < other.x + 12
+    player.dir /= Dying
+      && player.x + 4 < other.x + 12
       && other.x + 4 < player.x + 12
       && player.y + otherHeight - 4 < other.y + otherHeight
       && other.y + 4 < player.y + 24
diff --git a/src/Game/Entities/Player.hs b/src/Game/Entities/Player.hs
index 78da30e..f0a526c 100644
--- a/src/Game/Entities/Player.hs
+++ b/src/Game/Entities/Player.hs
@@ -58,11 +58,13 @@ updateVertical isBlocked jump down e
   | otherwise = e
 
 updatePlayer :: IORef C.Controls -> IsBlocked -> Entity -> IO Entity
-updatePlayer controls isBlocked e = do
-  ctl <- readIORef controls
-  pure $
-    updateGravity isBlocked $
-      updateVertical isBlocked ctl.a ctl.down $
-        updateHorizontal isBlocked ctl.left ctl.right $
-          -- left or right, but not both (keyboard)
-          updateFrame ((ctl.left || ctl.right) && (ctl.left /= ctl.right)) e
+updatePlayer controls isBlocked e
+  | e.dir /= Dying = do
+      ctl <- readIORef controls
+      pure $
+        updateGravity isBlocked $
+          updateVertical isBlocked ctl.a ctl.down $
+            updateHorizontal isBlocked ctl.left ctl.right $
+              -- left or right, but not both (keyboard)
+              updateFrame ((ctl.left || ctl.right) && (ctl.left /= ctl.right)) e
+  | otherwise = pure $ updateGravity (\_ _ -> False) e
diff --git a/src/Game/Entities/Types.hs b/src/Game/Entities/Types.hs
index ed609d3..a50ab2d 100644
--- a/src/Game/Entities/Types.hs
+++ b/src/Game/Entities/Types.hs
@@ -13,7 +13,7 @@ import Data.IORef
 import qualified Game.Sprites as S
 import qualified Game.State as GS
 
-data Dir = DirRight | DirLeft deriving (Eq)
+data Dir = DirRight | DirLeft | Dying deriving (Eq)
 
 data Type = TypePlayer | TypePickup | TypeEffect | TypeEnemy