aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2023-03-02 12:54:47 +0000
committerJuan J. Martinez <jjm@usebox.net>2023-03-02 12:54:47 +0000
commite5cbf917ad8b12b48932bc4fa13a044bc8159a74 (patch)
tree41511ca9f1447643ac921b2294f5dab8a62731e2
parent5dd9180606e935ee5a7c1637773fdfc3277677ca (diff)
downloadspace-plat-hs-e5cbf917ad8b12b48932bc4fa13a044bc8159a74.tar.gz
space-plat-hs-e5cbf917ad8b12b48932bc4fa13a044bc8159a74.zip
Even less IORef
Also reviewed comments and made the action to add effects more general.
-rw-r--r--src/Game.hs71
-rw-r--r--src/Game/Entities.hs86
-rw-r--r--src/Game/Entities/Player.hs2
-rw-r--r--src/Game/Entities/Types.hs7
-rw-r--r--src/Game/Hud.hs22
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