Map animations

1 files changed, 29 insertions, 7 deletions

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}