From 2d182c1f9c80a1e1ffb232bc6e17980cb3a64cf5 Mon Sep 17 00:00:00 2001 From: "Juan J. Martinez" Date: Mon, 13 Feb 2023 21:58:24 +0000 Subject: Pickups WIP TODO: collision --- src/Game/Entities.hs | 136 +++++++++++++++++++++++++++++++++------------------ 1 file changed, 88 insertions(+), 48 deletions(-) (limited to 'src/Game/Entities.hs') diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs index 36d25c1..ebb73d0 100644 --- a/src/Game/Entities.hs +++ b/src/Game/Entities.hs @@ -1,6 +1,8 @@ +{-# OPTIONS_GHC -Wno-unused-top-binds #-} + module Game.Entities (Entities, Entity, mkEntities, updateAll, render) where -import Data.Foldable (traverse_) +import Data.Foldable (find, traverse_) import Data.IORef import qualified Game.Controller as C import qualified Game.Map as M @@ -9,7 +11,7 @@ import qualified SDL data Dir = DirRight | DirLeft deriving (Eq) -data Type = TypePlayer | TypeEffect +data Type = TypePlayer | TypePickup | TypeEffect toSpriteSet :: Dir -> Int toSpriteSet DirRight = 0 @@ -36,7 +38,14 @@ jumpLimit = gravityDown + 7 gravityTable :: [Int] gravityTable = [0, 6, 4, 4, 2, 2, 2, 2, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 2, 2, 2, 2, 4] -data Entities = Entities S.SpriteSheet [Entity] +type MapCollision = Int -> Int -> Bool + +data Entities = Entities + { sprites :: S.SpriteSheet, + player :: IORef Entity, + entities :: [Entity], + mapCollision :: MapCollision + } data Spawn = DustEffectSpawn Int Int @@ -46,37 +55,47 @@ data Entity = Entity y :: Int, delay :: Int, frame :: Int, - frameLimit :: Int, jumping :: Bool, gravity :: Int, dir :: Dir, sprite :: S.Sprite, - update :: Entity -> IO Entity, - isBlocked :: Int -> Int -> Bool, + update :: Entity -> MapCollision -> IO Entity, destroy :: Bool, spawns :: [Spawn] } +frameLimit :: Entity -> Int +frameLimit e = S.frameCount e.sprite (toSpriteSet e.dir) + mkEntities :: S.SpriteSheet -> M.Map -> IORef C.Controls -> IO Entities mkEntities sprites m controls = do entities <- traverse toEntity $ M.objects m - pure $ Entities sprites entities + player <- case find isPlayer entities of + Just player -> newIORef player + Nothing -> error "No player entity in map" + pure $ Entities sprites player entities (M.isBlocked m) where toEntity :: M.Object -> IO Entity - toEntity (M.PlayerEntity x y) = mkPlayer sprites x y controls (M.isBlocked m) + toEntity (M.PlayerEntity x y) = mkPlayer sprites x y controls + toEntity (M.BatteryEntity x y) = mkBattery sprites x y + + isPlayer :: Entity -> Bool + isPlayer e = case e.typ of + TypePlayer -> True + _ -> False processSpawn :: S.SpriteSheet -> Spawn -> IO Entity processSpawn sprites (DustEffectSpawn x y) = mkEffect sprites x y "dust" updateAll :: Entities -> IO Entities -updateAll (Entities sprites entities) = do - updated <- traverse (\e -> e.update e) entities - new <- traverse (processSpawn sprites) (concatMap (\e -> e.spawns) updated) - pure $ Entities sprites $ map (\e -> e {spawns = []}) (filter (\e -> not e.destroy) updated) ++ new +updateAll es = do + updated <- traverse (\e -> e.update e es.mapCollision) es.entities + new <- traverse (processSpawn es.sprites) (concatMap (\e -> e.spawns) updated) + pure es {entities = map (\e -> e {spawns = []}) (filter (\e -> not e.destroy) updated) ++ new} render :: SDL.Renderer -> Entities -> IO () -render renderer (Entities _ entities) = do - traverse_ renderOne entities +render renderer es = do + traverse_ renderOne es.entities where renderOne :: Entity -> IO () renderOne e = @@ -94,13 +113,11 @@ mkEffect sprites x y name = do y = y, delay = frameDelay, frame = 0, - frameLimit = 3, jumping = False, gravity = gravityOff, dir = DirRight, sprite = s, - update = pure . updateEffect, - isBlocked = \_ _ -> False, + update = \e _ -> pure $ updateEffect e, destroy = False, spawns = [] } @@ -108,11 +125,36 @@ mkEffect sprites x y name = do updateEffect :: Entity -> Entity updateEffect e | e.delay > 0 = e {delay = e.delay - 1} - | e.frame + 1 < e.frameLimit = e {delay = e.frameLimit, frame = e.frame + 1} + | e.frame + 1 < frameLimit e = e {delay = frameDelay, frame = e.frame + 1} | otherwise = e {destroy = True} -mkPlayer :: S.SpriteSheet -> Int -> Int -> IORef C.Controls -> (Int -> Int -> Bool) -> IO Entity -mkPlayer sprites x y controls isBlocked' = do +mkBattery :: S.SpriteSheet -> Int -> Int -> IO Entity +mkBattery sprites x y = do + s <- S.get sprites "battery" + pure $ + Entity + { typ = TypePickup, + x = x, + y = y, + delay = frameDelay, + frame = 0, + jumping = False, + gravity = gravityOff, + dir = DirRight, + sprite = s, + update = \e _ -> pure $ updateBattery e, + destroy = False, + spawns = [] + } + +updateBattery :: Entity -> Entity +updateBattery e + | e.delay > 0 = e {delay = e.delay - 1} + | e.frame + 1 < frameLimit e = e {delay = frameDelay, frame = e.frame + 1} + | otherwise = e {delay = frameDelay, frame = 0} + +mkPlayer :: S.SpriteSheet -> Int -> Int -> IORef C.Controls -> IO Entity +mkPlayer sprites x y controls = do s <- S.get sprites "player" pure $ Entity @@ -121,13 +163,11 @@ mkPlayer sprites x y controls isBlocked' = do y = y, delay = 0, frame = 0, - frameLimit = 3, jumping = False, gravity = gravityOff, dir = DirRight, sprite = s, update = updatePlayer controls, - isBlocked = isBlocked', destroy = False, spawns = [] } @@ -136,28 +176,28 @@ updateFrame :: Bool -> Entity -> Entity updateFrame updated e | isGravityOn = e | e.delay > 0 = e {delay = e.delay - 1} - | e.frame < e.frameLimit = e {delay = frameDelay, frame = if updated then e.frame + 1 else 0} + | 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 -updateHorizontal :: Bool -> Bool -> Entity -> Entity -updateHorizontal left right e +updateHorizontal :: MapCollision -> Bool -> Bool -> Entity -> Entity +updateHorizontal isBlocked left right e -- prevent pressing both directions (kyboard) | 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 e.isBlocked (e.x - 1) (e.y + 23) then e else e {x = e.x - 1} - | left && not isGoingDown = if e.isBlocked (e.x - 1) (e.y + 23) && e.isBlocked (e.x - 1) (e.y + 17) then e else e {x = e.x - 1} - | right && isGoingDown = if e.isBlocked (e.x + 17) (e.y + 23) then e else e {x = e.x + 1} - | right && not isGoingDown = if e.isBlocked (e.x + 17) (e.y + 23) && e.isBlocked (e.x + 17) (e.y + 17) then e else e {x = e.x + 1} + | 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 :: Bool -> Bool -> Entity -> Entity -updateVertical jump down e +updateVertical :: MapCollision -> Bool -> Bool -> Entity -> Entity +updateVertical isBlocked jump down e | not jump || e.jumping -- make jumping easier with "Coyote time" @@ -167,40 +207,40 @@ updateVertical jump down e -- 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 (e.isBlocked (e.x + 2) (e.y + 24 + 8)) - && not (e.isBlocked (e.x + 12) (e.y + 24 + 8)) = + && not (isBlocked (e.x + 2) (e.y + 24 + 8)) + && not (isBlocked (e.x + 12) (e.y + 24 + 8)) = e {gravity = gravityDown, frame = jumpFrame, y = e.y + 1} | otherwise = e -applyGravity :: Int -> Entity -> Entity -applyGravity v e +applyGravity :: MapCollision -> Int -> Entity -> Entity +applyGravity isBlocked v e | v == 0 = e -- hit the floor | isGoingDown - && (e.isBlocked (e.x + 2) (e.y + 24) || e.isBlocked (e.x + 12) (e.y + 24)) - && not (e.isBlocked (e.x + 2) (e.y + 23)) - && not (e.isBlocked (e.x + 12) (e.y + 23)) = + && (isBlocked (e.x + 2) (e.y + 24) || isBlocked (e.x + 12) (e.y + 24)) + && not (isBlocked (e.x + 2) (e.y + 23)) + && not (isBlocked (e.x + 12) (e.y + 23)) = e {jumping = False, gravity = gravityOff, delay = 0} - | otherwise = applyGravity (v - 1) e {y = e.y + change} + | otherwise = applyGravity isBlocked (v - 1) e {y = e.y + change} where isGoingDown = e.gravity >= gravityDown change = if isGoingDown then 1 else -1 -updateGravity :: Entity -> Entity -updateGravity e - | current > gravityOff = applyGravity (gravityTable !! current) e {gravity = new} - | not (e.isBlocked (e.x + 2) (e.y + 24) || e.isBlocked (e.x + 12) (e.y + 24)) = e {gravity = gravityDown, frame = jumpFrame} +updateGravity :: MapCollision -> Entity -> Entity +updateGravity isBlocked e + | current > gravityOff = applyGravity isBlocked (gravityTable !! current) e {gravity = new} + | not (isBlocked (e.x + 2) (e.y + 24) || isBlocked (e.x + 12) (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 -updatePlayer :: IORef C.Controls -> Entity -> IO Entity -updatePlayer controls e = do +updatePlayer :: IORef C.Controls -> Entity -> MapCollision -> IO Entity +updatePlayer controls e isBlocked = do ctl <- readIORef controls pure $ - updateGravity $ - updateVertical ctl.a ctl.down $ - updateHorizontal ctl.left ctl.right $ + 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 -- cgit v1.2.3