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.Player (mkPlayer, dyingSet) where
import Data.IORef
import Game.Controller qualified as C
import Game.Entities.Common
import Game.Entities.Const
import Game.Entities.Types
import Game.Sprites qualified as S
dyingSet :: Int
dyingSet = 2
mkPlayer :: S.SpriteSheet -> Int -> Int -> IORef C.Controls -> IsBlocked -> IsBlocked -> IO Entity
mkPlayer sprites x y controls isBlocked isBlockedDeadly = do
s <- S.get sprites "player"
pure
Entity
{ typ = TypePlayer,
x = x,
y = y,
delay = 0,
frame = 0,
set = toSpriteSet DirRight,
jumping = False,
gravity = gravityOff,
dir = DirRight,
sprite = s,
update = updatePlayer controls isBlocked isBlockedDeadly,
destroy = False,
actions = [],
dat = PlayerData x y
}
updateHorizontal :: IsBlocked -> Bool -> Bool -> Entity -> Entity
updateHorizontal isBlocked left right e
-- prevent pressing both directions (keyboard)
| left && right = e
-- change direction first
| left && e.dir /= DirLeft = e {dir = DirLeft, set = toSpriteSet DirLeft, delay = 0}
| right && e.dir /= DirRight = e {dir = DirRight, set = toSpriteSet DirRight, delay = 0}
| left && isNotGoingDown = if isBlocked (e.x - 1) (e.y + 23) then e else e {x = e.x - 1}
| left && not isNotGoingDown = if isBlocked (e.x - 1) (e.y + 23) && isBlocked (e.x - 1) (e.y + 17) then e else e {x = e.x - 1}
| right && isNotGoingDown = if isBlocked (e.x + 17) (e.y + 23) then e else e {x = e.x + 1}
| right && not isNotGoingDown = if isBlocked (e.x + 17) (e.y + 23) && isBlocked (e.x + 17) (e.y + 17) then e else e {x = e.x + 1}
| otherwise = e
where
isNotGoingDown = e.gravity == gravityOff || e.gravity >= gravityDown
updateVertical :: IsBlocked -> Bool -> Bool -> Entity -> Entity
updateVertical isBlocked jump down e
| not jump
|| e.jumping
-- make jumping easier with "Coyote time"
|| (e.gravity /= gravityOff && (e.gravity < gravityDown || e.gravity > jumpLimit)) =
e
| not down = e {jumping = True, gravity = gravityUp, frame = jumpFrame, actions = [ActionAddEffect e.x (e.y + 8) "dust"]}
-- go down a 8 pixel tall platform; not ideal to have these values hardcoded here
-- but to be fair, the player height/width is hardcoded as well
| down
&& not (isBlocked (e.x + 4) (e.y + 24 + 8))
&& not (isBlocked (e.x + 10) (e.y + 24 + 8)) =
e {gravity = gravityDown, frame = jumpFrame, y = e.y + 1}
| otherwise = e
updateGravityCheckDeadly :: IsBlocked -> IsBlocked -> Entity -> Entity
updateGravityCheckDeadly isBlocked isBlockedDeadly e
| isBlockedDeadly (updated.x + 8) (updated.y + 24) = updated {actions = updated.actions ++ [ActionHitPlayerDeadly]}
| updated.gravity == gravityOff && e.gravity /= gravityOff = updated {dat = PlayerData updated.x updated.y}
| otherwise = updated
where
updated = updateGravity isBlocked e
updatePlayer :: IORef C.Controls -> IsBlocked -> IsBlocked -> Entity -> IO Entity
updatePlayer controls isBlocked isBlockedDeadly e
| e.set /= dyingSet = do
ctl <- readIORef controls
pure $
updateGravityCheckDeadly isBlocked isBlockedDeadly $
updateVertical isBlocked ctl.a ctl.down $
updateHorizontal isBlocked ctl.left ctl.right $
-- left or right, but not both (keyboard)
updateFrame ((ctl.left || ctl.right) && (ctl.left /= ctl.right)) e
| otherwise = pure $ updateGravity (\_ _ -> False) e
|
