diff options
author | Juan J. Martinez <jjm@usebox.net> | 2023-02-06 12:17:33 +0000 |
---|---|---|
committer | Juan J. Martinez <jjm@usebox.net> | 2023-02-06 12:17:33 +0000 |
commit | 049432fe1ffa4724f714a046adf21677a308f33f (patch) | |
tree | acaefd9dc3a42d81bb014f6297c17d837249e10f /src | |
parent | 116c1db2b45bac6db66119825d316662f6eb913c (diff) | |
download | space-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.hs | 11 | ||||
-rw-r--r-- | src/Game/Entities.hs | 55 |
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 |