aboutsummaryrefslogtreecommitdiff
path: root/src/Game/Entities/Player.hs
blob: 620f236b0111d1e1586b80ffcdf19db8e1962614 (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
module Game.Entities.Player (mkPlayer, dyingSet) where

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

dyingSet :: Int
dyingSet = 2

mkPlayer :: S.SpriteSheet -> Int -> Int -> IORef C.Controls -> IsBlocked -> IO Entity
mkPlayer sprites x y controls isBlocked = 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,
        destroy = False,
        actions = [],
        dat = NoData
      }

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 && isGoingDown = if isBlocked (e.x - 1) (e.y + 23) then e else e {x = e.x - 1}
  | left && not isGoingDown = if isBlocked (e.x - 1) (e.y + 23) && isBlocked (e.x - 1) (e.y + 17) then e else e {x = e.x - 1}
  | right && isGoingDown = if isBlocked (e.x + 17) (e.y + 23) then e else e {x = e.x + 1}
  | right && not isGoingDown = 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
    isGoingDown = 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

updatePlayer :: IORef C.Controls -> IsBlocked -> Entity -> IO Entity
updatePlayer controls isBlocked e
  | e.set /= dyingSet = do
      ctl <- readIORef controls
      pure $
        updateGravity isBlocked $
          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