aboutsummaryrefslogtreecommitdiff
path: root/src/Game/Entities/Common.hs
blob: 661fe07aed96f0a86d680f9125cf45c6a44c5a47 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
module Game.Entities.Common
  ( toSpriteSet,
    frameLimit,
    collision,
    inLine,
    updateFrame,
    updateGravity,
  )
where

import Data.IORef
import Game.Entities.Const
import Game.Entities.Types
import qualified Game.Sprites as S

-- | 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 e.set

-- | 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 -> Int -> Collision
collision playerRef otherHeight other = do
  player <- readIORef playerRef
  pure $
    player.typ == TypePlayer
      && player.x + 4 < other.x + 12
      && other.x + 4 < player.x + 12
      && 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
  | 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

-- 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