Added fixed pattern enemy (slimes)

2 files changed, 51 insertions, 2 deletions

diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs
index 9152175..f45ae1a 100644
--- a/src/Game/Entities.hs
+++ b/src/Game/Entities.hs
@@ -1,7 +1,9 @@
 module Game.Entities (Entities, Entity, mkEntities, updateAll, render) where
 
+import Data.Bits (Bits (..))
 import Data.Foldable (find, traverse_)
 import Data.IORef
+import Data.List (sort)
 import qualified Game.Controller as C
 import qualified Game.Map as M
 import qualified Game.Sprites as S
@@ -87,11 +89,12 @@ mkEntities sprites m controls stateRef = do
     Just (M.PlayerEntity x y) -> mkPlayer sprites x y controls (M.isBlocked m)
     _ -> error "No player entity in map"
   playerRef <- newIORef player
-  entities <- traverse (toEntity playerRef) $ filter (not . M.isPlayer) (M.objects m)
+  entities <- traverse (toEntity playerRef) $ sort $ filter (not . M.isPlayer) (M.objects m)
   -- the entities list has always player first
   pure $ Entities sprites playerRef (player : entities)
   where
     toEntity :: IORef Entity -> M.Object -> IO Entity
+    toEntity playerRef (M.SlimeEntity x y) = mkSlime sprites x y playerRef (M.isBlocked m)
     toEntity playerRef (M.BatteryEntity x y) = mkBattery sprites x y playerRef stateRef
     toEntity _ (M.PlayerEntity _ _) = error "Player already processed"
 
@@ -187,6 +190,49 @@ updateBattery touchedPlayer collectedBattery e = do
       | 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 Entity
+mkSlime sprites x y playerRef isBlocked = do
+  s <- S.get sprites "slime"
+  pure
+    Entity
+      { typ = TypePickup,
+        x = x,
+        y = y,
+        delay = frameDelay,
+        frame = 0,
+        jumping = False,
+        gravity = gravityOff,
+        dir = DirRight,
+        sprite = s,
+        update = updateSlime (collision playerRef) isBlocked,
+        destroy = False,
+        spawns = []
+      }
+
+updateSlime :: Collision -> IsBlocked -> Entity -> IO Entity
+updateSlime touchedPlayer isBlocked e = do
+  touched <- touchedPlayer e
+  let updated = updateSlimeFrame
+  pure $ if touched then e {destroy = True} else updateMovement updated
+  where
+    updateMovement :: Entity -> Entity
+    updateMovement e'
+      | testBit e'.delay 1 = e'
+      | e'.dir == DirLeft
+          && (isBlocked (e'.x - 1) (e'.y + 15) || isBlocked (e'.x - 1) (e'.y + 10) || not (isBlocked (e'.x - 1) (e'.y + 16))) =
+          e' {dir = DirRight}
+      | e'.dir == DirLeft = e' {x = e'.x - 1}
+      | e'.dir == DirRight
+          && (isBlocked (e'.x + 16) (e'.y + 15) || isBlocked (e'.x + 16) (e'.y + 10) || not (isBlocked (e'.x + 16) (e'.y + 16))) =
+          e' {dir = DirLeft}
+      | e'.dir == DirRight = e' {x = e'.x + 1}
+      | otherwise = e'
+    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"
diff --git a/src/Game/Map.hs b/src/Game/Map.hs
index ee30437..95e5618 100644
--- a/src/Game/Map.hs
+++ b/src/Game/Map.hs
@@ -36,7 +36,8 @@ data Layer
 data Object
   = PlayerEntity Int Int
   | BatteryEntity Int Int
-  deriving (Show)
+  | SlimeEntity Int Int
+  deriving (Show, Eq, Ord)
 
 data JsonMapData = JsonMapData
   { width :: Int,
@@ -75,6 +76,8 @@ instance JSON Object where
         PlayerEntity <$> valFromObj "x" obj <*> valFromObj "y" obj
       Just "Battery" ->
         BatteryEntity <$> valFromObj "x" obj <*> valFromObj "y" obj
+      Just "Slime" ->
+        SlimeEntity <$> valFromObj "x" obj <*> valFromObj "y" obj
       Just (JSString (JSONString s)) -> Error $ "unsupported entity " ++ show s
       e -> Error $ "unsupported entity in " ++ show e
   readJSON _ = mzero