aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2023-05-02 22:33:35 +0100
committerJuan J. Martinez <jjm@usebox.net>2023-05-02 22:33:35 +0100
commit5929ced84a5c1f55781988a1d88044c8866fa9dd (patch)
tree52ef7b7bb32cc0b721465645b12401145da1c61f /src
parent7ecc4c9af82ccd27f3eca610103b23a5e47158b3 (diff)
downloadspace-plat-hs-5929ced84a5c1f55781988a1d88044c8866fa9dd.tar.gz
space-plat-hs-5929ced84a5c1f55781988a1d88044c8866fa9dd.zip
Map animations
Diffstat (limited to 'src')
-rw-r--r--src/Game.hs4
-rw-r--r--src/Game/Map.hs36
2 files changed, 31 insertions, 9 deletions
diff --git a/src/Game.hs b/src/Game.hs
index d0092b6..c5fbdef 100644
--- a/src/Game.hs
+++ b/src/Game.hs
@@ -194,7 +194,7 @@ gameLoop e = do
playLoop :: Env -> IO Env
playLoop e = do
let renderer = e.renderer
- map' = e.map
+ map' = M.update e.map
entities = e.entities
hud = e.hud
@@ -213,7 +213,7 @@ playLoop e = do
SDL.rendererViewport renderer $= Nothing
H.render renderer hud state
- pure e {state = state, entities = updated}
+ pure e {state = state, entities = updated, map = map'}
gameOverLoop :: Env -> IO Env
gameOverLoop e = do
diff --git a/src/Game/Map.hs b/src/Game/Map.hs
index e22d18f..bb45918 100644
--- a/src/Game/Map.hs
+++ b/src/Game/Map.hs
@@ -6,6 +6,7 @@ module Game.Map
loadMapList,
load,
render,
+ update,
isBlocked,
isPlayer,
Viewport (..),
@@ -24,6 +25,9 @@ import qualified SDL
import Text.JSON
import Text.JSON.Types
+frameDelay :: Int
+frameDelay = 6
+
data Tileset = Tileset
{ cols :: Int,
width :: Int,
@@ -176,7 +180,12 @@ data MapData = MapData
data Viewport = Viewport Int Int Int Int
-data Map = Map MapData SDL.Texture
+data MapState = MapState
+ { delay :: Int,
+ step :: Int
+ }
+
+data Map = Map MapData SDL.Texture MapState
-- | Loads a list of maps from JSON file.
loadMapList :: String -> IO [String]
@@ -208,6 +217,7 @@ load filename tex = do
objects = concat $ mapMaybe filterObjectLayer s.layers
}
tex
+ (MapState 0 0)
Error e -> error e
where
filterTileLayer :: (Layer -> Bool) -> Layer -> Maybe [Int]
@@ -222,14 +232,14 @@ load filename tex = do
-- | Check for collision detection vs "Blocked" TileLayer.
-- x and y in pixels.
isBlocked :: Map -> Int -> Int -> Bool
-isBlocked (Map (MapData mapWidth _ tilesets _ blocked _) _) x y =
+isBlocked (Map (MapData mapWidth _ tilesets _ blocked _) _ _) x y =
blocked !! ((x `div` ts.width) + (y `div` ts.height) * mapWidth) >= ts.firstGid
where
ts = head tilesets
-- | Return the objects in a map.
objects :: Map -> [Object]
-objects (Map md _) = md.objects
+objects (Map md _ _) = md.objects
isPlayer :: Object -> Bool
isPlayer (PlayerEntity _ _) = True
@@ -247,7 +257,7 @@ totalBatteries m = length $ filter isBattery (objects m)
-- It returns the viewport to be used by render.
-- Optionally an offset can be provided.
viewport :: SDL.Renderer -> Map -> Int -> Int -> Int -> Int -> Maybe (Int, Int) -> IO Viewport
-viewport renderer (Map mapData _) vx vy vw vh offs = do
+viewport renderer (Map mapData _ _) vx vy vw vh offs = do
SDL.rendererViewport renderer $= Just mapRect
pure $ Viewport newx newy vw vh
where
@@ -271,7 +281,7 @@ viewport renderer (Map mapData _) vx vy vw vh offs = do
-- | Render a map.
-- Requires a Viewport from viewport.
render :: SDL.Renderer -> Map -> Viewport -> IO ()
-render renderer (Map mapData tex) (Viewport vx vy vw vh) = do
+render renderer (Map mapData tex (MapState _ step)) (Viewport vx vy vw vh) = do
mapM_
( \layer ->
mapM_
@@ -303,13 +313,25 @@ render renderer (Map mapData tex) (Viewport vx vy vw vh) = do
findTileset :: Int -> Maybe Tileset
findTileset tile = find (\t -> t.firstGid + t.tilecount > tile && t.firstGid <= tile) mapData.tilesets
+ findTile :: Tileset -> Int -> Int
+ findTile ts tile = case find (\t -> t.id == tile - ts.firstGid) ts.tiles of
+ Nothing -> tile - ts.firstGid
+ Just (Tile _ frames) -> fmap (\(Frame i) -> i) frames !! (step `mod` length frames)
+
renderTile :: Int -> Int -> Int -> IO ()
renderTile x y tile =
case findTileset tile of
Nothing -> pure ()
Just ts -> do
- let tx = (tile - ts.firstGid) `rem` ts.cols
- ty = (tile - ts.firstGid) `div` ts.cols
+ let tsTile = findTile ts tile
+ tx = tsTile `rem` ts.cols
+ ty = tsTile `div` ts.cols
src = U.rect (tx * ts.width) (ty * ts.height) ts.width ts.height
dst = U.rect (x * tileWidth) (y * tileHeight) ts.width ts.height
SDL.copy renderer tex (Just src) (Just dst)
+
+-- | Update the state of the map.
+update :: Map -> Map
+update (Map mapData texture state)
+ | state.delay < frameDelay = Map mapData texture state {delay = state.delay + 1}
+ | otherwise = Map mapData texture state {delay = 0, step = state.step + 1}