Added new shooter enemy

13 files changed, 152 insertions, 8 deletions

diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs
index 6506a60..25a7184 100644
--- a/src/Game/Entities.hs
+++ b/src/Game/Entities.hs
@@ -16,6 +16,7 @@ import Data.Foldable (find, traverse_)
 import Data.IORef
 import Data.List (sort)
 import qualified Game.Controller as C
+import Game.Entities.Blast
 import Game.Entities.Common
 import Game.Entities.Const
 import Game.Entities.Effect
@@ -24,6 +25,7 @@ import Game.Entities.Exit
 import Game.Entities.Pickup
 import Game.Entities.Player
 import Game.Entities.Robot
+import Game.Entities.Shooter
 import Game.Entities.Slime
 import Game.Entities.Types
 import qualified Game.Map as M
@@ -46,6 +48,7 @@ mkEntities sprites m controls = do
     toEntity :: IORef Entity -> M.Object -> IO Entity
     toEntity playerRef (M.SlimeEntity x y d) = mkSlime sprites x y d (collision playerRef 16) (M.isBlocked m)
     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.BatteryEntity x y) = mkBattery sprites x y (collision playerRef 16)
     toEntity _ (M.PlayerEntity _ _) = error "Player already processed"
 
@@ -110,6 +113,9 @@ updateAll es state = do
             t
         ActionEntryDone -> processActions s {GS.levelCompleted = GS.ExitOff} ents t
         ActionExitDone -> processActions s {GS.levelCompleted = GS.ExitDone} ents t
+        ActionAddBlast x y d playerCollision isBlocked -> do
+          blast <- mkBlast es.sprites x y d playerCollision isBlocked
+          processActions s (ents ++ [blast]) t
     processActions s ents [] = pure (s, ents)
 
     -- Update entities skipping enemies if the player was hit
diff --git a/src/Game/Entities/Blast.hs b/src/Game/Entities/Blast.hs
new file mode 100644
index 0000000..6e9fec2
--- /dev/null
+++ b/src/Game/Entities/Blast.hs
@@ -0,0 +1,40 @@
+module Game.Entities.Blast (mkBlast) where
+
+import Data.Bits (Bits (..))
+import Game.Entities.Const
+import Game.Entities.Types
+import qualified Game.Sprites as S
+
+mkBlast :: S.SpriteSheet -> Int -> Int -> Dir -> Collision -> IsBlocked -> IO Entity
+mkBlast sprites x y dir playerCollision isBlocked = do
+  s <- S.get sprites "blast"
+  pure
+    Entity
+      { typ = TypeEnemy,
+        x = x,
+        y = y,
+        delay = frameDelay,
+        frame = 0,
+        set = 0,
+        jumping = False,
+        gravity = gravityOff,
+        dir = dir,
+        sprite = s,
+        update = updateBlast playerCollision isBlocked,
+        destroy = False,
+        actions = [],
+        dat = NoData
+      }
+
+updateBlast :: Collision -> IsBlocked -> Entity -> IO Entity
+updateBlast touchedPlayer isBlocked e = do
+  touched <- touchedPlayer e
+  pure $ if touched then e {destroy = True, actions = [ActionHitPlayer, ActionAddEffect (e.x + 4) e.y "impact"]} else update
+  where
+    update
+      | e.dir == DirLeft && isBlocked (e.x - 1) (e.y + 4) = e {destroy = True, actions = [ActionAddEffect e.x e.y "impact"]}
+      | e.dir == DirLeft = updatedFrame {x = e.x - 1}
+      | e.dir == DirRight && isBlocked (e.x + 16) (e.y + 4) = e {destroy = True, actions = [ActionAddEffect (e.x + 8) e.y "impact"]}
+      | e.dir == DirRight = updatedFrame {x = e.x + 1}
+      | otherwise = updatedFrame
+    updatedFrame = if e.delay > 0 then e {delay = e.delay - 1} else e {delay = frameDelay, frame = e.frame `xor` 1}
diff --git a/src/Game/Entities/Common.hs b/src/Game/Entities/Common.hs
index 82e790e..661fe07 100644
--- a/src/Game/Entities/Common.hs
+++ b/src/Game/Entities/Common.hs
@@ -2,6 +2,7 @@ module Game.Entities.Common
   ( toSpriteSet,
     frameLimit,
     collision,
+    inLine,
     updateFrame,
     updateGravity,
   )
@@ -34,6 +35,19 @@ collision playerRef otherHeight other = do
       && player.y + otherHeight - 4 < other.y + otherHeight
       && other.y + 4 < player.y + 24
 
+-- | Check if the player is in line with the entity and the entity is facing the player.
+inLine :: IORef Entity -> Int -> Collision
+inLine playerRef otherHeight other = do
+  player <- readIORef playerRef
+  pure $
+    player.typ == TypePlayer
+      && player.y + otherHeight - 4 < other.y + otherHeight
+      && other.y + 4 < player.y + 24
+      -- XXX: adjust perhaps? so the enemies don't shoot too close to the player
+      && ( (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/Effect.hs b/src/Game/Entities/Effect.hs
index f8b668a..6f056d8 100644
--- a/src/Game/Entities/Effect.hs
+++ b/src/Game/Entities/Effect.hs
@@ -22,7 +22,8 @@ mkEffect sprites x y name = do
         sprite = s,
         update = pure . updateEffect,
         destroy = False,
-        actions = []
+        actions = [],
+        dat = NoData
       }
 
 updateEffect :: Entity -> Entity
diff --git a/src/Game/Entities/Entry.hs b/src/Game/Entities/Entry.hs
index 28b1c4e..18e29df 100644
--- a/src/Game/Entities/Entry.hs
+++ b/src/Game/Entities/Entry.hs
@@ -25,7 +25,8 @@ mkEntry sprites x y = do
         sprite = s,
         update = pure . updateEntry,
         destroy = False,
-        actions = []
+        actions = [],
+        dat = NoData
       }
 
 updateEntry :: Entity -> Entity
diff --git a/src/Game/Entities/Exit.hs b/src/Game/Entities/Exit.hs
index 206bfaa..f5e01a8 100644
--- a/src/Game/Entities/Exit.hs
+++ b/src/Game/Entities/Exit.hs
@@ -25,7 +25,8 @@ mkExit sprites x y playerCollision = do
         sprite = s,
         update = updateExit playerCollision,
         destroy = False,
-        actions = []
+        actions = [],
+        dat = NoData
       }
 
 updateExit :: Collision -> Entity -> IO Entity
diff --git a/src/Game/Entities/Pickup.hs b/src/Game/Entities/Pickup.hs
index 68d3852..7d6022c 100644
--- a/src/Game/Entities/Pickup.hs
+++ b/src/Game/Entities/Pickup.hs
@@ -22,7 +22,8 @@ mkBattery sprites x y playerCollision = do
         sprite = s,
         update = updateBattery playerCollision,
         destroy = False,
-        actions = []
+        actions = [],
+        dat = NoData
       }
 
 updateBattery :: Collision -> Entity -> IO Entity
diff --git a/src/Game/Entities/Player.hs b/src/Game/Entities/Player.hs
index 18625b6..620f236 100644
--- a/src/Game/Entities/Player.hs
+++ b/src/Game/Entities/Player.hs
@@ -27,7 +27,8 @@ mkPlayer sprites x y controls isBlocked = do
         sprite = s,
         update = updatePlayer controls isBlocked,
         destroy = False,
-        actions = []
+        actions = [],
+        dat = NoData
       }
 
 updateHorizontal :: IsBlocked -> Bool -> Bool -> Entity -> Entity
diff --git a/src/Game/Entities/Robot.hs b/src/Game/Entities/Robot.hs
index 664079a..11a10c5 100644
--- a/src/Game/Entities/Robot.hs
+++ b/src/Game/Entities/Robot.hs
@@ -23,7 +23,8 @@ mkRobot sprites x y d playerCollision isBlocked = do
         sprite = s,
         update = updateRobot playerCollision isBlocked,
         destroy = False,
-        actions = []
+        actions = [],
+        dat = NoData
       }
 
 updateRobot :: Collision -> IsBlocked -> Entity -> IO Entity
diff --git a/src/Game/Entities/Shooter.hs b/src/Game/Entities/Shooter.hs
new file mode 100644
index 0000000..6e9675f
--- /dev/null
+++ b/src/Game/Entities/Shooter.hs
@@ -0,0 +1,67 @@
+module Game.Entities.Shooter (mkShooter) where
+
+import Data.Bits (Bits (..))
+import Game.Entities.Common
+import Game.Entities.Const
+import Game.Entities.Types
+import qualified Game.Sprites as S
+
+blasterCoolDown :: Int
+blasterCoolDown = 128
+
+mkShooter :: S.SpriteSheet -> Int -> Int -> Dir -> Collision -> Collision -> IsBlocked -> Collision -> IO Entity
+mkShooter sprites x y d playerCollision playerInLine isBlocked playerVsBlast = do
+  s <- S.get sprites "shooter"
+  pure
+    Entity
+      { typ = TypeEnemy,
+        x = x,
+        y = y,
+        delay = frameDelay,
+        frame = 0,
+        set = toSpriteSet d,
+        jumping = False,
+        gravity = gravityOff,
+        dir = d,
+        sprite = s,
+        update = updateShooter playerCollision playerInLine isBlocked playerVsBlast,
+        destroy = False,
+        actions = [],
+        dat = ShooterData 0
+      }
+
+updateShooter :: Collision -> Collision -> IsBlocked -> Collision -> Entity -> IO Entity
+updateShooter touchedPlayer playerInLine isBlocked playerVsBlast e = do
+  touched <- touchedPlayer e
+  line <- playerInLine e
+  pure $ update touched line (updateFrame True (updateCoolDown e))
+  where
+    update :: Bool -> Bool -> Entity -> Entity
+    update wasTouched wasInLine ent
+      | wasInLine && ent.dat.coolDown == 0 =
+          ent
+            { dat = ShooterData blasterCoolDown,
+              actions = [ActionAddBlast blastX (ent.y + 8) ent.dir playerVsBlast isBlocked],
+              frame = 1,
+              delay = frameDelay * 2
+            }
+      | wasTouched = ent {actions = [ActionHitPlayer]}
+      | testBit ent.delay 1 = ent
+      | ent.dir == DirLeft
+          && (isBlocked (ent.x - 1) (ent.y + 17) || isBlocked (ent.x - 1) (ent.y + 17) || not (isBlocked (ent.x - 1) (ent.y + 24))) =
+          ent {dir = DirRight, set = toSpriteSet DirRight}
+      | ent.dir == DirLeft = ent {x = ent.x - 1}
+      | ent.dir == DirRight
+          && (isBlocked (ent.x + 16) (ent.y + 17) || isBlocked (ent.x + 16) (ent.y + 17) || not (isBlocked (ent.x + 16) (ent.y + 24))) =
+          ent {dir = DirLeft, set = toSpriteSet DirLeft}
+      | ent.dir == DirRight = ent {x = ent.x + 1}
+      | otherwise = ent
+
+    updateCoolDown :: Entity -> Entity
+    updateCoolDown ent
+      | ent.dat.coolDown > 0 = ent {dat = ShooterData (ent.dat.coolDown - 1)}
+      | otherwise = ent
+
+    blastX = case e.dir of
+      DirLeft -> e.x - 16
+      DirRight -> e.x + 16
diff --git a/src/Game/Entities/Slime.hs b/src/Game/Entities/Slime.hs
index 7607fb7..acbe638 100644
--- a/src/Game/Entities/Slime.hs
+++ b/src/Game/Entities/Slime.hs
@@ -23,7 +23,8 @@ mkSlime sprites x y d playerCollision isBlocked = do
         sprite = s,
         update = updateSlime playerCollision isBlocked,
         destroy = False,
-        actions = []
+        actions = [],
+        dat = NoData
       }
 
 updateSlime :: Collision -> IsBlocked -> Entity -> IO Entity
diff --git a/src/Game/Entities/Types.hs b/src/Game/Entities/Types.hs
index 05b419e..05726a8 100644
--- a/src/Game/Entities/Types.hs
+++ b/src/Game/Entities/Types.hs
@@ -6,6 +6,7 @@ module Game.Entities.Types
     Entities (..),
     Action (..),
     Entity (..),
+    EntityData (..),
   )
 where
 
@@ -16,6 +17,8 @@ data Dir = DirRight | DirLeft deriving (Eq, Show, Ord)
 
 data Type = TypePlayer | TypePickup | TypeEffect | TypeEnemy deriving (Eq)
 
+data EntityData = NoData | ShooterData {coolDown :: Int}
+
 type Collision = Entity -> IO Bool
 
 type IsBlocked = Int -> Int -> Bool
@@ -36,6 +39,7 @@ data Action
   | ActionExitStarted
   | ActionEntryDone
   | ActionExitDone
+  | ActionAddBlast Int Int Dir Collision IsBlocked
 
 data Entity = Entity
   { typ :: Type,
@@ -50,5 +54,6 @@ data Entity = Entity
     sprite :: S.Sprite,
     update :: Entity -> IO Entity,
     destroy :: Bool,
-    actions :: [Action]
+    actions :: [Action],
+    dat :: EntityData
   }
diff --git a/src/Game/Map.hs b/src/Game/Map.hs
index 9616971..1d395dc 100644
--- a/src/Game/Map.hs
+++ b/src/Game/Map.hs
@@ -43,6 +43,7 @@ data Object
   | BatteryEntity Int Int
   | SlimeEntity Int Int Dir
   | RobotEntity Int Int Dir
+  | ShooterEntity Int Int Dir
   deriving (Show, Eq, Ord)
 
 data JsonMapData = JsonMapData
@@ -86,10 +87,14 @@ instance JSON Object where
         SlimeEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> pure DirRight
       Just "Robot" ->
         RobotEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> pure DirRight
+      Just "Shooter" ->
+        ShooterEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> pure DirRight
       Just "Slime-l" ->
         SlimeEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> pure DirLeft
       Just "Robot-l" ->
         RobotEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> pure DirLeft
+      Just "Shooter-l" ->
+        ShooterEntity <$> 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