blob: 2e447f54a3617ab1d21c84c2f6ea1cb108619874 (
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
|
module Game.Entities.Common
( toSpriteSet,
frameLimit,
collision,
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
-- not really a direction
toSpriteSet Dying = 2
-- | Return the number of frames available on the entity's sprite for current direction.
frameLimit :: Entity -> Int
frameLimit e = S.frameCount e.sprite (toSpriteSet e.dir)
-- | 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.dir /= Dying
&& 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
-- | 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
|
