Swpan new entities

- Each entity can generate a list of "spawns" (add a new entity)
- Added a "dust" effect to the jump WIP

TODO: probably wrap the entity list in a type so we don't need to pass
the spritesheet to the update function.

2 files changed, 37 insertions, 8 deletions

diff --git a/src/Game.hs b/src/Game.hs
index 3121ddf..28e14e7 100644
--- a/src/Game.hs
+++ b/src/Game.hs
@@ -110,6 +110,7 @@ gameLoop = do
       controls = _controls env
       map' = _map env
       entities = _entities env
+      sprites = _sprites env
 
   events <- map SDL.eventPayload <$> SDL.pollEvents
 
@@ -125,8 +126,7 @@ gameLoop = do
     SDL.rendererRenderTarget renderer $= Just canvas
     SDL.clear renderer
 
-    -- update entities filtering out the ones that have been destroyed
-    updated <- liftIO $ fmap (filter (not . E.eDestroy)) (traverse (\e -> E.eUpdate e e) =<< readIORef entities)
+    updated <- liftIO $ E.update sprites =<< readIORef entities
     entities $= updated
 
     -- render map and entities
diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs
index bd11235..0cfdb47 100644
--- a/src/Game/Entities.hs
+++ b/src/Game/Entities.hs
@@ -1,4 +1,4 @@
-module Game.Entities (Entity (..), toSpriteSet, mkPlayer, render) where
+module Game.Entities (Entity (..), toSpriteSet, mkPlayer, mkEffect, update, render) where
 
 import Data.IORef
 import qualified Game.Controller as C
@@ -7,7 +7,7 @@ import qualified SDL
 
 data Dir = DirRight | DirLeft deriving (Eq)
 
-data Type = TypePlayer -- \| TypeEnemy | TypeItem
+data Type = TypePlayer | TypeEffect
 
 toSpriteSet :: Dir -> Int
 toSpriteSet DirRight = 0
@@ -31,6 +31,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 Spawn = DustEffectSpawn Int Int
+
 data Entity = Entity
   { eType :: Type,
     eX :: Int,
@@ -43,23 +45,40 @@ data Entity = Entity
     eSprite :: S.Sprite,
     eUpdate :: Entity -> IO Entity,
     eBlocked :: Int -> Int -> Bool,
-    eDestroy :: Bool
+    eDestroy :: Bool,
+    eSpawns :: [Spawn]
   }
 
+mkEffect :: S.SpriteSheet -> Int -> Int -> String -> IO Entity
+mkEffect sprites x y name = do
+  s <- S.get sprites name
+  pure $ Entity TypeEffect x y frameDelay 0 3 gravityOff DirRight s (pure . updateEffect) (\_ _ -> False) False []
+
+updateEffect :: Entity -> Entity
+updateEffect e
+  | delay > 0 = e {eDelay = delay - 1}
+  | frame + 1 < frameLimit = e {eDelay = frameDelay, eFrame = frame + 1}
+  | otherwise = e {eDestroy = True}
+  where
+    frame = eFrame e
+    frameLimit = eFrameLimit e
+    delay = eDelay e
+
 mkPlayer :: S.SpriteSheet -> Int -> Int -> IORef C.Controls -> (Int -> Int -> Bool) -> IO Entity
 mkPlayer sprites x y controls isBlocked = do
   s <- S.get sprites "player"
-  pure $ Entity TypePlayer x y 0 0 3 gravityOff DirRight s (updatePlayer controls) isBlocked False
+  pure $ Entity TypePlayer x y 0 0 3 gravityOff DirRight s (updatePlayer controls) isBlocked False []
 
 updateFrame :: Bool -> Entity -> Entity
 updateFrame updated e
   | isGravityOn = e
   | delay > 0 = e {eDelay = delay - 1}
-  | frame < eFrameLimit e = e {eDelay = frameDelay, eFrame = if updated then frame + 1 else 0}
+  | frame < frameLimit = e {eDelay = frameDelay, eFrame = if updated then frame + 1 else 0}
   | otherwise = e {eDelay = frameDelay, eFrame = 0}
   where
     isGravityOn = eGravity e > gravityOff
     frame = eFrame e
+    frameLimit = eFrameLimit e
     delay = eDelay e
 
 updateHorizontal :: Bool -> Bool -> Entity -> Entity
@@ -84,7 +103,7 @@ updateHorizontal left right e
 updateVertical :: Bool -> Bool -> Entity -> Entity
 updateVertical jump down e
   | not jump || gravity /= gravityOff = e
-  | not down = e {eGravity = gravityUp, eFrame = jumpFrame}
+  | not down = e {eGravity = gravityUp, eFrame = jumpFrame, eSpawns = events ++ [DustEffectSpawn x (y + 8)]}
   -- 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
@@ -97,6 +116,7 @@ updateVertical jump down e
     y = eY e
     gravity = eGravity e
     isBlocked = eBlocked e
+    events = eSpawns e
 
 applyGravity :: Int -> Entity -> Entity
 applyGravity v e
@@ -138,6 +158,15 @@ updatePlayer controls e = do
           -- 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