module Game.Entities.Player (mkPlayer) 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 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, jumping = False, gravity = gravityOff, dir = DirRight, sprite = s, update = updatePlayer controls isBlocked, destroy = False, actions = [] } 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, delay = 0} | right && e.dir /= DirRight = e {dir = 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 = [ActionAddDustEffect e.x (e.y + 8)]} -- 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.dir /= Dying = 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