aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2023-02-06 12:17:33 +0000
committerJuan J. Martinez <jjm@usebox.net>2023-02-06 12:17:33 +0000
commit049432fe1ffa4724f714a046adf21677a308f33f (patch)
treeacaefd9dc3a42d81bb014f6297c17d837249e10f /src
parent116c1db2b45bac6db66119825d316662f6eb913c (diff)
downloadspace-plat-hs-049432fe1ffa4724f714a046adf21677a308f33f.tar.gz
space-plat-hs-049432fe1ffa4724f714a046adf21677a308f33f.zip
Wrap entities operations on a type
Diffstat (limited to 'src')
-rw-r--r--src/Game.hs11
-rw-r--r--src/Game/Entities.hs55
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