aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2023-02-20 21:52:22 +0000
committerJuan J. Martinez <jjm@usebox.net>2023-02-20 21:52:22 +0000
commited585355b1f78de15885e803138a98b75ca2b1e2 (patch)
treeda25f10539fa39ee284dc49ab9d5e53721bc008f /src
parent92785d2df84e18953048a6537b71c824a2a4b288 (diff)
downloadspace-plat-hs-ed585355b1f78de15885e803138a98b75ca2b1e2.tar.gz
space-plat-hs-ed585355b1f78de15885e803138a98b75ca2b1e2.zip
Split entities in modules.
Diffstat (limited to 'src')
-rw-r--r--src/Game/Entities.hs287
-rw-r--r--src/Game/Entities/Common.hs87
-rw-r--r--src/Game/Entities/Const.hs25
-rw-r--r--src/Game/Entities/Effect.hs31
-rw-r--r--src/Game/Entities/Pickup.hs37
-rw-r--r--src/Game/Entities/Player.hs68
-rw-r--r--src/Game/Entities/Slime.hs51
-rw-r--r--src/Game/Entities/Types.hs46
8 files changed, 352 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
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]
+ }