Split entities in modules.

1 files changed, 68 insertions, 0 deletions

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