Even less IORef

Also reviewed comments and made the action to add effects more general.

5 files changed, 92 insertions, 96 deletions

diff --git a/src/Game.hs b/src/Game.hs
index 41c8178..851b7fc 100644
--- a/src/Game.hs
+++ b/src/Game.hs
@@ -47,8 +47,8 @@ data Env = Env
     font :: BF.BitmapFont,
     entities :: E.Entities,
     hud :: H.Hud,
-    controls :: IORef C.Controls,
-    state :: IORef GS.State
+    state :: GS.State,
+    controls :: IORef C.Controls
   }
 
 defaultRenderRect :: SDL.Rectangle CInt
@@ -77,19 +77,18 @@ main = do
   map' <- M.load "data/map.json" tsTexture
   sprites <- S.load "data/sprites.json" ssTexture
   font <- BF.load "data/font.json" bfTexture
-  state <-
-    newIORef
-      GS.State
-        { batteries = 0,
-          totalBatteries = M.totalBatteries map',
-          lives = maxLives,
-          totalLives = maxLives,
-          hitDelay = 0,
-          gameOverDelay = 0
-        }
   controls <- newIORef =<< C.init
-  hud <- H.mkHud sprites state
-  entities <- E.mkEntities sprites map' controls state
+  entities <- E.mkEntities sprites map' controls
+  hud <- H.mkHud sprites
+  let initialState =
+        GS.State
+          { batteries = 0,
+            totalBatteries = M.totalBatteries map',
+            lives = maxLives,
+            totalLives = maxLives,
+            hitDelay = 0,
+            gameOverDelay = 0
+          }
   gameLoop
     Env
       { window = window,
@@ -102,8 +101,8 @@ main = do
         font = font,
         entities = entities,
         hud = hud,
-        controls = controls,
-        state = state
+        state = initialState,
+        controls = controls
       }
   SDL.destroyWindow window
   SDL.quit
@@ -140,8 +139,7 @@ gameLoop e = do
       canvas = env.canvas
       renderRect = env.renderRect
       controls = env.controls
-      stateRef = env.state
-      entities = env.entities
+      state = env.state
 
   -- ESC or close the window to quit
   let quit = fromMaybe False (U.isPressed SDL.KeycodeEscape events) || SDL.QuitEvent `elem` events
@@ -152,11 +150,7 @@ gameLoop e = do
     SDL.rendererRenderTarget renderer $= Just canvas
     SDL.clear renderer
 
-    state <- readIORef stateRef
-    when (state.gameOverDelay > 1) $ stateRef $= state {GS.gameOverDelay = state.gameOverDelay - 1}
-    when (state.gameOverDelay == 1) $ gameOverLoop env
-
-    updatedEntities <- if state.gameOverDelay /= 1 then playLoop env else pure entities
+    updatedEnv <- if state.gameOverDelay /= 1 then playLoop (updateState env) else gameOverLoop env
 
     SDL.rendererRenderTarget renderer $= Nothing
     SDL.clear renderer
@@ -164,39 +158,48 @@ gameLoop e = do
 
     SDL.present renderer
 
-    gameLoop env {entities = updatedEntities}
-
-playLoop :: Env -> IO E.Entities
+    gameLoop updatedEnv
+  where
+    -- update state counters
+    updateState :: Env -> Env
+    updateState env
+      | state.gameOverDelay > 1 = env {state = state {GS.gameOverDelay = state.gameOverDelay - 1}}
+      | otherwise = env
+      where
+        state = env.state
+
+playLoop :: Env -> IO Env
 playLoop e = do
   let renderer = e.renderer
       map' = e.map
       entities = e.entities
       hud = e.hud
 
-  updated <- E.updateAll entities
+  (updated, state) <- E.updateAll entities e.state
 
   -- to update the map viewport
   let (px, py) = E.playerPosition updated
 
-  -- render map and entities
-
   -- set the SDL viewport
   viewport <- M.viewport renderer map' px py (fromIntegral gameWidth) (fromIntegral gameHeight - H.height) (Just (0, H.height))
+  -- render map and entities
   M.render renderer map' viewport
-  E.renderVisible renderer updated viewport
+  E.renderVisible renderer updated viewport state
 
   -- reset viewport to draw the HUD
   SDL.rendererViewport renderer $= Nothing
-  H.render renderer hud
+  H.render renderer hud state
 
-  pure updated
+  pure e {state = state, entities = updated}
 
-gameOverLoop :: Env -> IO ()
+gameOverLoop :: Env -> IO Env
 gameOverLoop e = do
   let renderer = e.renderer
       sprites = e.sprites
+      state = e.state
       hud = e.hud
 
-  H.render renderer hud
+  H.render renderer hud state
   title <- S.get sprites "game-over"
   S.render renderer title 112 80 0 0
+  pure e
diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs
index 0c1a4f3..2810fcf 100644
--- a/src/Game/Entities.hs
+++ b/src/Game/Entities.hs
@@ -17,18 +17,17 @@ import Game.Entities.Types
 import qualified Game.Map as M
 import qualified Game.Sprites as S
 import qualified Game.State as GS
-import SDL (($~))
 import qualified SDL
 
-mkEntities :: S.SpriteSheet -> M.Map -> IORef C.Controls -> IORef GS.State -> IO Entities
-mkEntities sprites m controls stateRef = do
+mkEntities :: S.SpriteSheet -> M.Map -> IORef C.Controls -> IO Entities
+mkEntities sprites m controls = do
   player <- case find M.isPlayer (M.objects m) of
     Just (M.PlayerEntity x y) -> mkPlayer sprites x y controls (M.isBlocked m)
     _ -> error "No player entity in map"
   playerRef <- newIORef player
   entities <- traverse (toEntity playerRef) $ sort $ filter (not . M.isPlayer) (M.objects m)
   -- the entities list has always player first
-  pure $ Entities sprites playerRef stateRef (player : entities)
+  pure $ Entities sprites playerRef (player : entities)
   where
     toEntity :: IORef Entity -> M.Object -> IO Entity
     toEntity playerRef (M.SlimeEntity x y) = mkSlime sprites x y (collision playerRef 16) (M.isBlocked m)
@@ -38,55 +37,54 @@ mkEntities sprites m controls stateRef = do
 
 -- | Return the player's entity position (x, y).
 playerPosition :: Entities -> (Int, Int)
-playerPosition (Entities _ _ _ entities) =
+playerPosition (Entities _ _ entities) =
   (player.x, player.y)
   where
     player = head entities
 
-updateAll :: Entities -> IO Entities
-updateAll es = do
+updateAll :: Entities -> GS.State -> IO (Entities, GS.State)
+updateAll es state = do
   -- update the player first (including the reference)
   updatedPlayer <- player.update player
   void $ writeIORef es.player updatedPlayer
-  state <- readIORef stateRef
-  -- update hit delay if the player was hit
-  let playerWasHit = state.hitDelay > 0
-  when playerWasHit (writeIORef stateRef state {GS.hitDelay = state.hitDelay - 1})
   -- then the other entities
-  updated <- (updatedPlayer :) <$> traverse (updateFilter playerWasHit) others
+  updated <- (updatedPlayer :) <$> traverse (updateFilter $ state.hitDelay > 0) others
   -- process actions
-  updated' <- processActions updated (concatMap (\e -> e.actions) updated)
-  -- clear actions, filter out destroyed entities, and add the new ones
-  pure es {entities = map (\e -> e {actions = []}) (filter (\e -> not e.destroy) updated')}
+  (state', updated') <- processActions (updateState state) updated (concatMap (\e -> e.actions) updated)
+  -- clear actions and filter out destroyed entities
+  pure (es {entities = map (\e -> e {actions = []}) (filter (\e -> not e.destroy) updated')}, state')
   where
-    stateRef = es.state
     player = head es.entities
     others = tail es.entities
 
-    -- the actions can add new entities of modify existing ones
-    processActions :: [Entity] -> [Action] -> IO [Entity]
-    processActions ents (a : t) =
+    -- update state counters
+    updateState :: GS.State -> GS.State
+    updateState s = if s.hitDelay > 0 then s {GS.hitDelay = s.hitDelay - 1} else s
+
+    -- the actions can change the game state, add new entities, and modify existing ones
+    processActions :: GS.State -> [Entity] -> [Action] -> IO (GS.State, [Entity])
+    processActions s ents (a : t) =
       case a of
-        ActionAddDustEffect x y -> do
-          effect <- mkEffect es.sprites x y "dust"
-          processActions (ents ++ [effect]) t
-        ActionAddBattery -> do
-          stateRef $~ (\s -> s {GS.batteries = s.batteries + 1})
-          processActions ents t
+        ActionAddEffect x y name -> do
+          effect <- mkEffect es.sprites x y name
+          processActions s (ents ++ [effect]) t
+        ActionAddBattery ->
+          processActions s {GS.batteries = s.batteries + 1} ents t
         ActionHitPlayer -> do
-          s <- readIORef stateRef
-          ents' <-
-            if s.lives == 1
-              then do
-                writeIORef stateRef s {GS.lives = 0, GS.gameOverDelay = gameOverDelay}
-                pure $ (head ents) {dir = Dying, gravity = gravityUp, frame = 0} : tail ents
-              else do
-                writeIORef stateRef s {GS.lives = s.lives - 1, GS.hitDelay = hitDelay}
-                pure ents
-          processActions ents' t
-    processActions ents [] = pure ents
+          let (s', ents') =
+                if s.lives == 1
+                  then
+                    ( s {GS.lives = 0, GS.gameOverDelay = gameOverDelay},
+                      (head ents) {dir = Dying, gravity = gravityUp, frame = 0} : tail ents
+                    )
+                  else
+                    ( s {GS.lives = s.lives - 1, GS.hitDelay = hitDelay},
+                      ents
+                    )
+          processActions s' ents' t
+    processActions s ents [] = pure (s, ents)
 
-    -- Update entities skipping enemies if the player was hit.
+    -- Update entities skipping enemies if the player was hit
     updateFilter :: Bool -> Entity -> IO Entity
     updateFilter False e = e.update e
     updateFilter True e
@@ -98,10 +96,9 @@ updateAll es = do
       TypeEnemy -> False
       _ -> True
 
--- | Render only visible entities according to the provided viewport.
-renderVisible :: SDL.Renderer -> Entities -> M.Viewport -> IO ()
-renderVisible renderer (Entities sprites player state entities) v =
-  render renderer (Entities sprites player state visible)
+-- | Render only visible entities according to the provided viewport and state.
+renderVisible :: SDL.Renderer -> Entities -> M.Viewport -> GS.State -> IO ()
+renderVisible renderer (Entities sprites player entities) v = render renderer (Entities sprites player visible)
   where
     -- FIXME: entities should have size so we can be exact here and
     -- avoid the hardcoded size
@@ -110,9 +107,10 @@ renderVisible renderer (Entities sprites player state entities) v =
     isVisible (M.Viewport vx vy vw vh) x y w h =
       x < vx + vw && vx < x + w && y < vy + vh && vy < y + h
 
-render :: SDL.Renderer -> Entities -> IO ()
-render renderer es = do
-  state <- readIORef es.state
+-- | Render all entities according to the provided state.
+-- Use renderVisible to only render the entities that are in the viewport area.
+render :: SDL.Renderer -> Entities -> GS.State -> IO ()
+render renderer es state = do
   -- if the player was hit, make the enemies wiggle before unfreezing
   if state.hitDelay == 0 || state.hitDelay > hitDelay `div` 3
     then traverse_ renderOne others
diff --git a/src/Game/Entities/Player.hs b/src/Game/Entities/Player.hs
index 87e8a7a..a69799b 100644
--- a/src/Game/Entities/Player.hs
+++ b/src/Game/Entities/Player.hs
@@ -48,7 +48,7 @@ updateVertical isBlocked jump down e
       -- make jumping easier with "Coyote time"
       || (e.gravity /= gravityOff && (e.gravity < gravityDown || e.gravity > jumpLimit)) =
       e
-  | not down = e {jumping = True, gravity = gravityUp, frame = jumpFrame, actions = [ActionAddDustEffect e.x (e.y + 8)]}
+  | not down = e {jumping = True, gravity = gravityUp, frame = jumpFrame, actions = [ActionAddEffect e.x (e.y + 8) "dust"]}
   -- go down a 8 pixel tall platform; not ideal to have these values hardcoded here
   -- but to be fair, the player height/width is hardcoded as well
   | down
diff --git a/src/Game/Entities/Types.hs b/src/Game/Entities/Types.hs
index e22032b..dce4ffa 100644
--- a/src/Game/Entities/Types.hs
+++ b/src/Game/Entities/Types.hs
@@ -11,7 +11,6 @@ where
 
 import Data.IORef
 import qualified Game.Sprites as S
-import qualified Game.State as GS
 
 data Dir = DirRight | DirLeft | Dying deriving (Eq)
 
@@ -24,11 +23,13 @@ type IsBlocked = Int -> Int -> Bool
 data Entities = Entities
   { sprites :: S.SpriteSheet,
     player :: IORef Entity,
-    state :: IORef GS.State,
     entities :: [Entity]
   }
 
-data Action = ActionAddDustEffect Int Int | ActionAddBattery | ActionHitPlayer deriving (Show)
+-- | The effect name must match the sprite name in the spritesheet.
+type EffectName = String
+
+data Action = ActionAddEffect Int Int EffectName | ActionAddBattery | ActionHitPlayer
 
 data Entity = Entity
   { typ :: Type,
diff --git a/src/Game/Hud.hs b/src/Game/Hud.hs
index 880de50..a5d3e22 100644
--- a/src/Game/Hud.hs
+++ b/src/Game/Hud.hs
@@ -1,6 +1,5 @@
 module Game.Hud (Hud, mkHud, render, height) where
 
-import Data.IORef
 import qualified Game.Sprites as S
 import qualified Game.State as GS
 import qualified SDL
@@ -8,21 +7,16 @@ import qualified SDL
 height :: Int
 height = 16
 
-data Hud = Hud
-  { sprite :: S.Sprite,
-    stateRef :: IORef GS.State
-  }
+newtype Hud = Hud S.Sprite
 
-mkHud :: S.SpriteSheet -> IORef GS.State -> IO Hud
-mkHud sprites stateRef = do
-  sprite <- S.get sprites "hud"
-  pure Hud {sprite = sprite, stateRef = stateRef}
+mkHud :: S.SpriteSheet -> IO Hud
+mkHud sprites = do
+  Hud <$> S.get sprites "hud"
 
-render :: SDL.Renderer -> Hud -> IO ()
-render renderer hud = do
-  state <- readIORef hud.stateRef
+render :: SDL.Renderer -> Hud -> GS.State -> IO ()
+render renderer (Hud sprite) state = do
   let xs = [0 .. state.totalBatteries - 1]
-   in mapM_ (\x -> S.render renderer hud.sprite (4 + x * 8) 4 0 (if state.batteries <= x then 0 else 1)) xs
+   in mapM_ (\x -> S.render renderer sprite (4 + x * 8) 4 0 (if state.batteries <= x then 0 else 1)) xs
   let xs = [0 .. state.totalLives - 1]
    in -- magic numbers
-      mapM_ (\x -> S.render renderer hud.sprite (320 - 4 - state.totalLives * 8 + x * 8) 4 0 (if state.lives <= x then 2 else 3)) xs
+      mapM_ (\x -> S.render renderer sprite (320 - 4 - state.totalLives * 8 + x * 8) 4 0 (if state.lives <= x then 2 else 3)) xs