Split entities in modules.

1 files changed, 7 insertions, 280 deletions

diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs
index 31019ab..1977678 100644
--- a/src/Game/Entities.hs
+++ b/src/Game/Entities.hs
@@ -6,101 +6,18 @@ import Data.Foldable (find, traverse_)
 import Data.IORef
 import Data.List (sort)
 import qualified Game.Controller as C
+import Game.Entities.Common
+import Game.Entities.Const
+import Game.Entities.Effect
+import Game.Entities.Pickup
+import Game.Entities.Player
+import Game.Entities.Slime
+import Game.Entities.Types
 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)
-
-data Type = TypePlayer | TypePickup | TypeEffect | TypeEnemy
-
-toSpriteSet :: Dir -> Int
-toSpriteSet DirRight = 0
-toSpriteSet DirLeft = 1
-
-hitDelay :: Int
-hitDelay = 96
-
-frameDelay :: Int
-frameDelay = 6
-
-jumpFrame :: Int
-jumpFrame = 3
-
-gravityOff :: Int
-gravityOff = -1
-
-gravityUp :: Int
-gravityUp = 0
-
-gravityDown :: Int
-gravityDown = 14
-
-jumpLimit :: Int
-jumpLimit = gravityDown + 7
-
-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]
-
-type IsBlocked = Int -> Int -> Bool
-
-data Entities = Entities
-  { sprites :: S.SpriteSheet,
-    player :: IORef Entity,
-    state :: IORef GS.State,
-    entities :: [Entity]
-  }
-
-data Spawn = DustEffectSpawn Int Int
-
-data Entity = Entity
-  { typ :: Type,
-    x :: Int,
-    y :: Int,
-    delay :: Int,
-    frame :: Int,
-    jumping :: Bool,
-    gravity :: Int,
-    dir :: Dir,
-    sprite :: S.Sprite,
-    update :: Entity -> IO Entity,
-    destroy :: Bool,
-    spawns :: [Spawn]
-  }
-
--- | Returns the number of frames available on the entity's sprite for current direction.
-frameLimit :: Entity -> Int
-frameLimit e = S.frameCount e.sprite (toSpriteSet e.dir)
-
-type Collision = Entity -> IO Bool
-
--- | Collision detection of player vs entity.
---
--- The player's head won't register, this is necessary to avoid hitting things on a platform above when jumping.
-collision :: IORef Entity -> Collision
-collision playerRef other = do
-  player <- readIORef playerRef
-  pure $
-    player.x + 4 < other.x + 12
-      && other.x + 4 < player.x + 12
-      && player.y + 12 < other.y + 16
-      && other.y + 4 < player.y + 24
-
--- | Update game state to reflect that the player was hit by an enemy.
-hitPlayer :: IORef GS.State -> IO ()
-hitPlayer stateRef =
-  stateRef $~ updatePlayerHit
-  where
-    updatePlayerHit :: GS.State -> GS.State
-    updatePlayerHit s = s {GS.lives = s.lives - 1, GS.hitDelay = hitDelay}
-
--- | Update game state to reflect that the player picked up a battery.
-collectedBattery :: IORef GS.State -> IO ()
-collectedBattery stateRef =
-  stateRef $~ (\s -> s {GS.batteries = s.batteries + 1})
-
 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
@@ -174,193 +91,3 @@ render renderer es = do
       S.render renderer e.sprite e.x e.y set e.frame
       where
         set = toSpriteSet e.dir
-
-mkEffect :: S.SpriteSheet -> Int -> Int -> String -> IO Entity
-mkEffect sprites x y name = do
-  s <- S.get sprites name
-  pure
-    Entity
-      { typ = TypeEffect,
-        x = x,
-        y = y,
-        delay = frameDelay,
-        frame = 0,
-        jumping = False,
-        gravity = gravityOff,
-        dir = DirRight,
-        sprite = s,
-        update = pure . updateEffect,
-        destroy = False,
-        spawns = []
-      }
-
-updateEffect :: Entity -> Entity
-updateEffect e
-  | e.delay > 0 = e {delay = e.delay - 1}
-  | e.frame + 1 < frameLimit e = e {delay = frameDelay, frame = e.frame + 1}
-  | otherwise = e {destroy = True}
-
-mkBattery :: S.SpriteSheet -> Int -> Int -> IORef Entity -> IO () -> IO Entity
-mkBattery sprites x y playerRef collectedBattery' = do
-  s <- S.get sprites "battery"
-  pure
-    Entity
-      { typ = TypePickup,
-        x = x,
-        y = y,
-        delay = frameDelay,
-        frame = 0,
-        jumping = False,
-        gravity = gravityOff,
-        dir = DirRight,
-        sprite = s,
-        update = updateBattery (collision playerRef) collectedBattery',
-        destroy = False,
-        spawns = []
-      }
-
-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
-      | e.delay > 0 = e {delay = e.delay - 1}
-      | e.frame + 1 < frameLimit e = e {delay = frameDelay, frame = e.frame + 1}
-      | otherwise = e {delay = frameDelay, frame = 0}
-
-mkSlime :: S.SpriteSheet -> Int -> Int -> IORef Entity -> IsBlocked -> IO () -> IO Entity
-mkSlime sprites x y playerRef isBlocked hitPlayer' = do
-  s <- S.get sprites "slime"
-  pure
-    Entity
-      { typ = TypeEnemy,
-        x = x,
-        y = y,
-        delay = frameDelay,
-        frame = 0,
-        jumping = False,
-        gravity = gravityOff,
-        dir = DirRight,
-        sprite = s,
-        update = updateSlime (collision playerRef) isBlocked hitPlayer',
-        destroy = False,
-        spawns = []
-      }
-
-updateSlime :: Collision -> IsBlocked -> IO () -> Entity -> IO Entity
-updateSlime touchedPlayer isBlocked hitPlayer' e = do
-  touched <- touchedPlayer e
-  let updated = updateSlimeFrame
-  if touched then fmap (const e) hitPlayer' else pure $ updateMovement updated
-  where
-    updateMovement :: Entity -> Entity
-    updateMovement ent
-      | testBit ent.delay 1 = ent
-      | ent.dir == DirLeft
-          && (isBlocked (ent.x - 1) (ent.y + 15) || isBlocked (ent.x - 1) (ent.y + 10) || not (isBlocked (ent.x - 1) (ent.y + 16))) =
-          ent {dir = DirRight}
-      | ent.dir == DirLeft = ent {x = ent.x - 1}
-      | ent.dir == DirRight
-          && (isBlocked (ent.x + 16) (ent.y + 15) || isBlocked (ent.x + 16) (ent.y + 10) || not (isBlocked (ent.x + 16) (ent.y + 16))) =
-          ent {dir = DirLeft}
-      | ent.dir == DirRight = ent {x = ent.x + 1}
-      | otherwise = ent
-    updateSlimeFrame :: Entity
-    updateSlimeFrame
-      | e.delay > 0 = e {delay = e.delay - 1}
-      | e.frame + 1 < frameLimit e = e {delay = frameDelay + 2, frame = e.frame + 1}
-      | otherwise = e {delay = frameDelay + 2, frame = 0}
-
-mkPlayer :: S.SpriteSheet -> Int -> Int -> IORef C.Controls -> IsBlocked -> IO Entity
-mkPlayer sprites x y controls isBlocked = do
-  s <- S.get sprites "player"
-  pure
-    Entity
-      { typ = TypePlayer,
-        x = x,
-        y = y,
-        delay = 0,
-        frame = 0,
-        jumping = False,
-        gravity = gravityOff,
-        dir = DirRight,
-        sprite = s,
-        update = updatePlayer controls isBlocked,
-        destroy = False,
-        spawns = []
-      }
-
-updateFrame :: Bool -> Entity -> Entity
-updateFrame updated e
-  | isGravityOn = e
-  | e.delay > 0 = e {delay = e.delay - 1}
-  | e.frame + 1 < frameLimit e = e {delay = frameDelay, frame = if updated then e.frame + 1 else 0}
-  | otherwise = e {delay = frameDelay, frame = 0}
-  where
-    isGravityOn = e.gravity > gravityOff
-
-updateHorizontal :: IsBlocked -> Bool -> Bool -> Entity -> Entity
-updateHorizontal isBlocked left right e
-  -- prevent pressing both directions (keyboard)
-  | left && right = e
-  -- change direction first
-  | left && e.dir /= DirLeft = e {dir = DirLeft, delay = 0}
-  | right && e.dir /= DirRight = e {dir = DirRight, delay = 0}
-  | left && isGoingDown = if isBlocked (e.x - 1) (e.y + 23) then e else e {x = e.x - 1}
-  | left && not isGoingDown = if isBlocked (e.x - 1) (e.y + 23) && isBlocked (e.x - 1) (e.y + 17) then e else e {x = e.x - 1}
-  | right && isGoingDown = if isBlocked (e.x + 17) (e.y + 23) then e else e {x = e.x + 1}
-  | right && not isGoingDown = if isBlocked (e.x + 17) (e.y + 23) && isBlocked (e.x + 17) (e.y + 17) then e else e {x = e.x + 1}
-  | otherwise = e
-  where
-    isGoingDown = e.gravity == gravityOff || e.gravity >= gravityDown
-
-updateVertical :: IsBlocked -> Bool -> Bool -> Entity -> Entity
-updateVertical isBlocked jump down e
-  | not jump
-      || e.jumping
-      -- make jumping easier with "Coyote time"
-      || (e.gravity /= gravityOff && (e.gravity < gravityDown || e.gravity > jumpLimit)) =
-      e
-  | not down = e {jumping = True, gravity = gravityUp, frame = jumpFrame, spawns = e.spawns ++ [DustEffectSpawn e.x (e.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
-      && not (isBlocked (e.x + 4) (e.y + 24 + 8))
-      && not (isBlocked (e.x + 10) (e.y + 24 + 8)) =
-      e {gravity = gravityDown, frame = jumpFrame, y = e.y + 1}
-  | otherwise = e
-
-applyGravity :: IsBlocked -> Int -> Entity -> Entity
-applyGravity isBlocked v e
-  | v == 0 = e
-  -- hit the floor
-  | isGoingDown
-      && (isBlocked (e.x + 4) (e.y + 24) || isBlocked (e.x + 10) (e.y + 24))
-      && not (isBlocked (e.x + 4) (e.y + 23))
-      && not (isBlocked (e.x + 10) (e.y + 23)) =
-      e {jumping = False, gravity = gravityOff, delay = 0}
-  | otherwise = applyGravity isBlocked (v - 1) e {y = e.y + change}
-  where
-    isGoingDown = e.gravity >= gravityDown
-    change = if isGoingDown then 1 else -1
-
-updateGravity :: IsBlocked -> Entity -> Entity
-updateGravity isBlocked e
-  | current > gravityOff = applyGravity isBlocked (gravityTable !! current) e {gravity = new}
-  | not (isBlocked (e.x + 4) (e.y + 24) || isBlocked (e.x + 10) (e.y + 24)) = e {gravity = gravityDown, frame = jumpFrame}
-  | otherwise = e
-  where
-    current = e.gravity
-    new = if current > gravityOff && current < length gravityTable - 1 then current + 1 else current
-
-updatePlayer :: IORef C.Controls -> IsBlocked -> Entity -> IO Entity
-updatePlayer controls isBlocked e = do
-  ctl <- readIORef controls
-  pure $
-    updateGravity isBlocked $
-      updateVertical isBlocked ctl.a ctl.down $
-        updateHorizontal isBlocked ctl.left ctl.right $
-          -- left or right, but not both (keyboard)
-          updateFrame ((ctl.left || ctl.right) && (ctl.left /= ctl.right)) e