Added "tracker" enemy

4 files changed, 46 insertions, 0 deletions

diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs
index a0c596d..3cb2510 100644
--- a/src/Game/Entities.hs
+++ b/src/Game/Entities.hs
@@ -28,6 +28,7 @@ import Game.Entities.Robot
 import Game.Entities.Runner
 import Game.Entities.Shooter
 import Game.Entities.Slime
+import Game.Entities.Tracker
 import Game.Entities.Types
 import qualified Game.Map as M
 import qualified Game.Sprites as S
@@ -51,6 +52,7 @@ mkEntities sprites m controls = do
     toEntity playerRef (M.RobotEntity x y d) = mkRobot sprites x y d (collision playerRef 24) (M.isBlocked m)
     toEntity playerRef (M.ShooterEntity x y d) = mkShooter sprites x y d (collision playerRef 24) (inLine playerRef 24) (M.isBlocked m) (collision playerRef 8)
     toEntity playerRef (M.RunnerEntity x y d) = mkRunner sprites x y d (collision playerRef 24) (M.isBlocked m)
+    toEntity playerRef (M.TrackerEntity x y d) = mkTracker sprites x y d (collision playerRef 24) (facingLower playerRef) (M.isBlocked m)
     toEntity playerRef (M.BatteryEntity x y) = mkBattery sprites x y (collision playerRef 16)
     toEntity _ (M.PlayerEntity _ _) = error "Player already processed"
 
diff --git a/src/Game/Entities/Common.hs b/src/Game/Entities/Common.hs
index eb84400..8fa7fe3 100644
--- a/src/Game/Entities/Common.hs
+++ b/src/Game/Entities/Common.hs
@@ -3,6 +3,7 @@ module Game.Entities.Common
     frameLimit,
     collision,
     inLine,
+    facingLower,
     updateFrame,
     updateGravity,
     turn,
@@ -54,6 +55,18 @@ inLine playerRef otherHeight other = do
              || (other.dir == DirRight && player.x > other.x)
          )
 
+-- | Check if the entity is facing the player and it is in a lower plarform.
+facingLower :: IORef Entity -> Collision
+facingLower playerRef other = do
+  player <- readIORef playerRef
+  pure $
+    player.typ == TypePlayer
+      && player.gravity == gravityOff
+      && player.y < other.y
+      && ( (other.dir == DirLeft && player.x < other.x)
+             || (other.dir == DirRight && player.x > other.x)
+         )
+
 -- | Update frame animation for entities that have direction.
 updateFrame :: Bool -> Entity -> Entity
 updateFrame updated e
diff --git a/src/Game/Entities/Tracker.hs b/src/Game/Entities/Tracker.hs
new file mode 100644
index 0000000..ef7325f
--- /dev/null
+++ b/src/Game/Entities/Tracker.hs
@@ -0,0 +1,26 @@
+module Game.Entities.Tracker (mkTracker) where
+
+import Game.Entities.Const
+import Game.Entities.Runner
+import Game.Entities.Types
+import qualified Game.Sprites as S
+
+mkTracker :: S.SpriteSheet -> Int -> Int -> Dir -> Collision -> Collision -> IsBlocked -> IO Entity
+mkTracker sprites x y d playerCollision facingPlayerLower isBlocked = do
+  s <- S.get sprites "tracker"
+  runner <- mkRunner sprites x y d playerCollision isBlocked
+  pure runner {sprite = s, update = updateTracker runner.update facingPlayerLower isBlocked}
+
+updateTracker :: (Entity -> IO Entity) -> Collision -> IsBlocked -> Entity -> IO Entity
+updateTracker updateRunner facingPlayerLower isBlocked ent = do
+  e <- updateRunner ent
+  facing <- facingPlayerLower e
+  pure $
+    if facing && e.gravity == gravityOff && not (isBlocked (ent.x + 8) (ent.y - 1)) && isBlocked (ent.x + 8) ent.y
+      then
+        e
+          { gravity = gravityUp,
+            frame = jumpFrame,
+            actions = [ActionAddEffect ent.x (ent.y + 8) "dust"]
+          }
+      else e
diff --git a/src/Game/Map.hs b/src/Game/Map.hs
index 6c01061..2a85dbe 100644
--- a/src/Game/Map.hs
+++ b/src/Game/Map.hs
@@ -45,6 +45,7 @@ data Object
   | RobotEntity Int Int Dir
   | ShooterEntity Int Int Dir
   | RunnerEntity Int Int Dir
+  | TrackerEntity Int Int Dir
   deriving (Show, Eq, Ord)
 
 data JsonMapData = JsonMapData
@@ -92,6 +93,8 @@ instance JSON Object where
         ShooterEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> pure DirRight
       Just "Runner" ->
         RunnerEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> pure DirRight
+      Just "Tracker" ->
+        TrackerEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> pure DirRight
       Just "Slime-l" ->
         SlimeEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> pure DirLeft
       Just "Robot-l" ->
@@ -100,6 +103,8 @@ instance JSON Object where
         ShooterEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> pure DirLeft
       Just "Runner-l" ->
         RunnerEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> pure DirLeft
+      Just "Tracker-l" ->
+        TrackerEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> pure DirLeft
       Just (JSString (JSONString s)) -> Error $ "unsupported entity " ++ show s
       e -> Error $ "unsupported entity in " ++ show e
   readJSON _ = mzero