Game state, HUD, ... WIP

Exploring ideas.

5 files changed, 84 insertions, 24 deletions

diff --git a/src/Game.hs b/src/Game.hs
index c267453..a7454b8 100644
--- a/src/Game.hs
+++ b/src/Game.hs
@@ -7,8 +7,10 @@ import Data.Text (pack)
 import Foreign.C.Types (CInt)
 import qualified Game.Controller as C
 import qualified Game.Entities as E
+import qualified Game.Hud as H
 import qualified Game.Map as M
 import qualified Game.Sprites as S
+import qualified Game.State as GS
 import Game.Utils (isPressed)
 import SDL (($=), ($~))
 import qualified SDL
@@ -19,7 +21,7 @@ name :: String
 name = "Haskell gamedev [Space Platformer]"
 
 gameWidth, gameHeight :: CInt
-(gameWidth, gameHeight) = (320, 180)
+(gameWidth, gameHeight) = (320, 192)
 
 gameScale :: CInt
 gameScale = 3
@@ -39,7 +41,9 @@ data Env = Env
     controls :: IORef C.Controls,
     map :: M.Map,
     sprites :: S.SpriteSheet,
-    entities :: IORef E.Entities
+    entities :: IORef E.Entities,
+    hud :: H.Hud,
+    state :: IORef GS.State
   }
 
 defaultRenderRect :: SDL.Rectangle CInt
@@ -69,7 +73,14 @@ main = do
   controls <- newIORef =<< C.init
   map' <- M.load "data/map.json" tsTexture
   sprites <- S.load "data/sprites.json" ssTexture
-  entities <- newIORef =<< E.mkEntities sprites map' controls
+  state <-
+    newIORef
+      GS.State
+        { batteries = 0,
+          totalBatteries = M.totalBatteries map'
+        }
+  hud <- H.mkHud sprites state
+  entities <- newIORef =<< E.mkEntities sprites map' controls state
   runReaderT
     gameLoop
     Env
@@ -81,7 +92,9 @@ main = do
         controls = controls,
         map = map',
         sprites = sprites,
-        entities = entities
+        entities = entities,
+        hud = hud,
+        state = state
       }
   SDL.destroyWindow window
   SDL.quit
@@ -120,6 +133,7 @@ gameLoop = do
       controls = env.controls
       map' = env.map
       entities = env.entities
+      hud = env.hud
 
   events <- map SDL.eventPayload <$> SDL.pollEvents
 
@@ -141,9 +155,11 @@ gameLoop = do
     -- render map and entities
     void $ liftIO $ do
       M.render renderer map'
+      H.render renderer hud
       E.render renderer updated
 
     SDL.rendererRenderTarget renderer $= Nothing
+    SDL.clear renderer
     rect <- SDL.get renderRect
     SDL.copy renderer canvas Nothing (Just rect)
 
diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs
index d0ef4eb..95d9626 100644
--- a/src/Game/Entities.hs
+++ b/src/Game/Entities.hs
@@ -5,6 +5,8 @@ import Data.IORef
 import qualified Game.Controller as C
 import qualified Game.Map as M
 import qualified Game.Sprites as S
+import qualified Game.State as GS
+import SDL (($~))
 import qualified SDL
 
 data Dir = DirRight | DirLeft deriving (Eq)
@@ -79,24 +81,20 @@ collision playerRef other = do
       && player.y + 12 < other.y + 16
       && other.y + 4 < player.y + 24
 
-mkEntities :: S.SpriteSheet -> M.Map -> IORef C.Controls -> IO Entities
-mkEntities sprites m controls = do
-  player <- case find isPlayer (M.objects m) of
+mkEntities :: S.SpriteSheet -> M.Map -> IORef C.Controls -> IORef GS.State -> IO Entities
+mkEntities sprites m controls stateRef = 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) $ filter (not . isPlayer) (M.objects m)
+  entities <- traverse (toEntity playerRef) $ filter (not . M.isPlayer) (M.objects m)
   -- the entities list has always player first
   pure $ Entities sprites playerRef (player : entities)
   where
     toEntity :: IORef Entity -> M.Object -> IO Entity
-    toEntity playerRef (M.BatteryEntity x y) = mkBattery sprites x y playerRef
+    toEntity playerRef (M.BatteryEntity x y) = mkBattery sprites x y playerRef stateRef
     toEntity _ (M.PlayerEntity _ _) = error "Player already processed"
 
-    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"
 
@@ -133,7 +131,7 @@ render renderer es = do
 mkEffect :: S.SpriteSheet -> Int -> Int -> String -> IO Entity
 mkEffect sprites x y name = do
   s <- S.get sprites name
-  pure $
+  pure
     Entity
       { typ = TypeEffect,
         x = x,
@@ -155,10 +153,10 @@ updateEffect e
   | e.frame + 1 < frameLimit e = e {delay = frameDelay, frame = e.frame + 1}
   | otherwise = e {destroy = True}
 
-mkBattery :: S.SpriteSheet -> Int -> Int -> IORef Entity -> IO Entity
-mkBattery sprites x y playerRef = do
+mkBattery :: S.SpriteSheet -> Int -> Int -> IORef Entity -> IORef GS.State -> IO Entity
+mkBattery sprites x y playerRef stateRef = do
   s <- S.get sprites "battery"
-  pure $
+  pure
     Entity
       { typ = TypePickup,
         x = x,
@@ -169,15 +167,19 @@ mkBattery sprites x y playerRef = do
         gravity = gravityOff,
         dir = DirRight,
         sprite = s,
-        update = updateBattery (collision playerRef),
+        update = updateBattery (collision playerRef) collectedBattery,
         destroy = False,
         spawns = []
       }
-
-updateBattery :: Collision -> Entity -> IO Entity
-updateBattery touchedPlayer e = do
-  -- XXX: how do we update game state? :thinkingface:
-  (\t -> if t then e {destroy = True} else updateBatteryFrame) <$> touchedPlayer e
+  where
+    collectedBattery :: IO ()
+    collectedBattery = do
+      stateRef $~ (\s -> s {GS.batteries = s.batteries + 1})
+
+updateBattery :: Collision -> IO () -> Entity -> IO Entity
+updateBattery touchedPlayer collectedBattery e = do
+  touched <- touchedPlayer e
+  if touched then e {destroy = True} <$ collectedBattery else pure updateBatteryFrame
   where
     updateBatteryFrame :: Entity
     updateBatteryFrame
@@ -188,7 +190,7 @@ updateBattery touchedPlayer e = do
 mkPlayer :: S.SpriteSheet -> Int -> Int -> IORef C.Controls -> IsBlocked -> IO Entity
 mkPlayer sprites x y controls isBlocked = do
   s <- S.get sprites "player"
-  pure $
+  pure
     Entity
       { typ = TypePlayer,
         x = x,
diff --git a/src/Game/Hud.hs b/src/Game/Hud.hs
new file mode 100644
index 0000000..3b59558
--- /dev/null
+++ b/src/Game/Hud.hs
@@ -0,0 +1,22 @@
+module Game.Hud (Hud, mkHud, render) where
+
+import Data.IORef
+import qualified Game.Sprites as S
+import qualified Game.State as GS
+import qualified SDL
+
+data Hud = Hud
+  { sprite :: S.Sprite,
+    stateRef :: IORef GS.State
+  }
+
+mkHud :: S.SpriteSheet -> IORef GS.State -> IO Hud
+mkHud sprites stateRef = do
+  sprite <- S.get sprites "hud"
+  pure Hud {sprite = sprite, stateRef = stateRef}
+
+render :: SDL.Renderer -> Hud -> IO ()
+render renderer hud = do
+  state <- readIORef hud.stateRef
+  let xs = [0 .. state.totalBatteries - 1]
+  mapM_ (\x -> S.render renderer hud.sprite (4 + x * 8) 178 0 (if state.batteries <= x then 0 else 1)) xs
diff --git a/src/Game/Map.hs b/src/Game/Map.hs
index 3855d16..ee30437 100644
--- a/src/Game/Map.hs
+++ b/src/Game/Map.hs
@@ -2,9 +2,11 @@ module Game.Map
   ( Map (..),
     Object (..),
     objects,
+    totalBatteries,
     load,
     render,
     isBlocked,
+    isPlayer,
   )
 where
 
@@ -142,6 +144,18 @@ isBlocked (Map (MapData mapWidth _ ts _ blocked _) _) x y =
 objects :: Map -> [Object]
 objects (Map md _) = md.objects
 
+isPlayer :: Object -> Bool
+isPlayer (PlayerEntity _ _) = True
+isPlayer _ = False
+
+-- | Return the number of batteries in a map.
+totalBatteries :: Map -> Int
+totalBatteries m = length $ filter isBattery (objects m)
+  where
+    isBattery :: Object -> Bool
+    isBattery (BatteryEntity _ _) = True
+    isBattery _ = False
+
 -- | Renders a map.
 render :: SDL.Renderer -> Map -> IO ()
 render renderer (Map mapData tex) = do
diff --git a/src/Game/State.hs b/src/Game/State.hs
new file mode 100644
index 0000000..9988936
--- /dev/null
+++ b/src/Game/State.hs
@@ -0,0 +1,6 @@
+module Game.State (State (..)) where
+
+data State = State
+  { batteries :: Int,
+    totalBatteries :: Int
+  }