From e5cbf917ad8b12b48932bc4fa13a044bc8159a74 Mon Sep 17 00:00:00 2001 From: "Juan J. Martinez" Date: Thu, 2 Mar 2023 12:54:47 +0000 Subject: Even less IORef Also reviewed comments and made the action to add effects more general. --- src/Game.hs | 71 +++++++++++++++++++------------------ src/Game/Entities.hs | 86 ++++++++++++++++++++++----------------------- src/Game/Entities/Player.hs | 2 +- src/Game/Entities/Types.hs | 7 ++-- src/Game/Hud.hs | 22 +++++------- 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 -- cgit v1.2.3