Wrap entities operations on a type

2 files changed, 40 insertions, 26 deletions

diff --git a/src/Game.hs b/src/Game.hs
index 28e14e7..667053d 100644
--- a/src/Game.hs
+++ b/src/Game.hs
@@ -39,7 +39,7 @@ data Env = Env
     _controls :: IORef C.Controls,
     _map :: M.Map,
     _sprites :: S.SpriteSheet,
-    _entities :: IORef [E.Entity]
+    _entities :: IORef E.Entities
   }
 
 defaultRenderRect :: SDL.Rectangle CInt
@@ -69,9 +69,9 @@ main = do
   controls <- newIORef =<< C.init
   map' <- M.load "data/map.json" tsTexture
   sprites <- S.load "data/sprites.json" ssTexture
-  entities <- newIORef ([] :: [E.Entity])
+  entities <- newIORef $ E.mkEntities sprites
   player <- E.mkPlayer sprites 32 104 controls (M.isBlocked map')
-  entities $~ (player :)
+  entities $~ E.append player
   runReaderT gameLoop (Env window renderer canvas fullscreen renderRect controls map' sprites entities)
   SDL.destroyWindow window
   SDL.quit
@@ -110,7 +110,6 @@ gameLoop = do
       controls = _controls env
       map' = _map env
       entities = _entities env
-      sprites = _sprites env
 
   events <- map SDL.eventPayload <$> SDL.pollEvents
 
@@ -126,13 +125,13 @@ gameLoop = do
     SDL.rendererRenderTarget renderer $= Just canvas
     SDL.clear renderer
 
-    updated <- liftIO $ E.update sprites =<< readIORef entities
+    updated <- liftIO $ E.update =<< readIORef entities
     entities $= updated
 
     -- render map and entities
     void $ liftIO $ do
       M.render renderer map'
-      traverse (E.render renderer) updated
+      E.render renderer updated
 
     SDL.rendererRenderTarget renderer $= Nothing
     rect <- SDL.get renderRect
diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs
index 0cfdb47..66d2da6 100644
--- a/src/Game/Entities.hs
+++ b/src/Game/Entities.hs
@@ -1,5 +1,8 @@
-module Game.Entities (Entity (..), toSpriteSet, mkPlayer, mkEffect, update, render) where
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
 
+module Game.Entities (Entities, mkEntities, mkPlayer, mkEffect, append, update, render) where
+
+import Data.Foldable (traverse_)
 import Data.IORef
 import qualified Game.Controller as C
 import qualified Game.Sprites as S
@@ -31,6 +34,8 @@ gravityDown = 16
 gravityTable :: [Int]
 gravityTable = [0, 6, 4, 4, 2, 2, 2, 2, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 2, 2, 2, 2, 4]
 
+data Entities = Entities S.SpriteSheet [Entity]
+
 data Spawn = DustEffectSpawn Int Int
 
 data Entity = Entity
@@ -49,6 +54,35 @@ data Entity = Entity
     eSpawns :: [Spawn]
   }
 
+mkEntities :: S.SpriteSheet -> Entities
+mkEntities sprites = Entities sprites []
+
+append :: Entity -> Entities -> Entities
+append e (Entities sprites entities) = Entities sprites (entities ++ [e])
+
+processSpawn :: S.SpriteSheet -> Spawn -> IO Entity
+processSpawn sprites (DustEffectSpawn x y) = mkEffect sprites x y "dust"
+
+update :: Entities -> IO Entities
+update (Entities sprites entities) = do
+  updated <- traverse (\e -> eUpdate e e) entities
+  new <- traverse (processSpawn sprites) (concatMap eSpawns updated)
+  pure $ Entities sprites $ map (\e -> e {eSpawns = []}) (filter (not . eDestroy) updated) ++ new
+
+render :: SDL.Renderer -> Entities -> IO ()
+render renderer (Entities _ entities) = do
+  traverse_ renderOne entities
+  where
+    renderOne :: Entity -> IO ()
+    renderOne e =
+      S.render renderer sp x y set frame
+      where
+        sp = eSprite e
+        x = eX e
+        y = eY e
+        set = toSpriteSet $ eDir e
+        frame = eFrame e
+
 mkEffect :: S.SpriteSheet -> Int -> Int -> String -> IO Entity
 mkEffect sprites x y name = do
   s <- S.get sprites name
@@ -157,22 +191,3 @@ updatePlayer controls e = do
         updateHorizontal (C.cLeft ctl) (C.cRight ctl) $
           -- left or right, but not both (keyboard)
           updateFrame ((C.cLeft ctl || C.cRight ctl) && (C.cLeft ctl /= C.cRight ctl)) e
-
-processSpawn :: S.SpriteSheet -> Spawn -> IO Entity
-processSpawn sprites (DustEffectSpawn x y) = mkEffect sprites x y "dust"
-
-update :: S.SpriteSheet -> [Entity] -> IO [Entity]
-update sprites entities = do
-  updated <- traverse (\e -> eUpdate e e) entities
-  new <- traverse (processSpawn sprites) (concatMap eSpawns updated)
-  pure $ map (\e -> e {eSpawns = []}) (filter (not . eDestroy) updated) ++ new
-
-render :: SDL.Renderer -> Entity -> IO ()
-render renderer ent =
-  S.render renderer sp x y set frame
-  where
-    sp = eSprite ent
-    x = eX ent
-    y = eY ent
-    set = toSpriteSet $ eDir ent
-    frame = eFrame ent