Split entities in modules.

7 files changed, 345 insertions, 0 deletions

diff --git a/src/Game/Entities/Common.hs b/src/Game/Entities/Common.hs
new file mode 100644
index 0000000..b79c3db
--- /dev/null
+++ b/src/Game/Entities/Common.hs
@@ -0,0 +1,87 @@
+module Game.Entities.Common
+  ( toSpriteSet,
+    frameLimit,
+    collision,
+    hitPlayer,
+    collectedBattery,
+    updateFrame,
+    updateGravity,
+  )
+where
+
+import Data.IORef
+import Game.Entities.Const
+import Game.Entities.Types
+import qualified Game.Sprites as S
+import qualified Game.State as GS
+import SDL (($~))
+
+-- | Convert direction into a sprite set.
+toSpriteSet :: Dir -> Int
+toSpriteSet DirRight = 0
+toSpriteSet DirLeft = 1
+
+-- | Return 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)
+
+-- | 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})
+
+-- | Update frame animation for entities that have direction.
+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
+
+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
+
+-- | Update gravity.
+--
+-- XXX: hardcoded to 16x24 pixels sprite.
+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
diff --git a/src/Game/Entities/Const.hs b/src/Game/Entities/Const.hs
new file mode 100644
index 0000000..4855e24
--- /dev/null
+++ b/src/Game/Entities/Const.hs
@@ -0,0 +1,25 @@
+module Game.Entities.Const where
+
+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]
diff --git a/src/Game/Entities/Effect.hs b/src/Game/Entities/Effect.hs
new file mode 100644
index 0000000..0a20445
--- /dev/null
+++ b/src/Game/Entities/Effect.hs
@@ -0,0 +1,31 @@
+module Game.Entities.Effect (mkEffect) where
+
+import Game.Entities.Common
+import Game.Entities.Const
+import Game.Entities.Types
+import qualified Game.Sprites as S
+
+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}
diff --git a/src/Game/Entities/Pickup.hs b/src/Game/Entities/Pickup.hs
new file mode 100644
index 0000000..d0f80f6
--- /dev/null
+++ b/src/Game/Entities/Pickup.hs
@@ -0,0 +1,37 @@
+module Game.Entities.Pickup (mkBattery) where
+
+import Data.IORef
+import Game.Entities.Common
+import Game.Entities.Const
+import Game.Entities.Types
+import qualified Game.Sprites as S
+
+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}
diff --git a/src/Game/Entities/Player.hs b/src/Game/Entities/Player.hs
new file mode 100644
index 0000000..78da30e
--- /dev/null
+++ b/src/Game/Entities/Player.hs
@@ -0,0 +1,68 @@
+module Game.Entities.Player (mkPlayer) where
+
+import Data.IORef
+import qualified Game.Controller as C
+import Game.Entities.Common
+import Game.Entities.Const
+import Game.Entities.Types
+import qualified Game.Sprites as S
+
+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 = []
+      }
+
+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
+
+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
diff --git a/src/Game/Entities/Slime.hs b/src/Game/Entities/Slime.hs
new file mode 100644
index 0000000..91e756f
--- /dev/null
+++ b/src/Game/Entities/Slime.hs
@@ -0,0 +1,51 @@
+module Game.Entities.Slime (mkSlime) where
+
+import Data.Bits (Bits (..))
+import Data.IORef
+import Game.Entities.Common
+import Game.Entities.Const
+import Game.Entities.Types
+import qualified Game.Sprites as S
+
+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}
diff --git a/src/Game/Entities/Types.hs b/src/Game/Entities/Types.hs
new file mode 100644
index 0000000..ed609d3
--- /dev/null
+++ b/src/Game/Entities/Types.hs
@@ -0,0 +1,46 @@
+module Game.Entities.Types
+  ( Dir (..),
+    Type (..),
+    Collision,
+    IsBlocked,
+    Entities (..),
+    Spawn (..),
+    Entity (..),
+  )
+where
+
+import Data.IORef
+import qualified Game.Sprites as S
+import qualified Game.State as GS
+
+data Dir = DirRight | DirLeft deriving (Eq)
+
+data Type = TypePlayer | TypePickup | TypeEffect | TypeEnemy
+
+type Collision = Entity -> IO Bool
+
+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]
+  }