From b3bd745ce3950c63e3c32ed218a3b9091a2f8461 Mon Sep 17 00:00:00 2001 From: "Juan J. Martinez" Date: Tue, 2 May 2023 23:28:23 +0100 Subject: Use vector instead of list Should be more performant, access O(1) to elements. --- src/Game/Map.hs | 77 ++++++++++++++++++++++++++++++--------------------------- 1 file changed, 41 insertions(+), 36 deletions(-) diff --git a/src/Game/Map.hs b/src/Game/Map.hs index bb45918..29597dd 100644 --- a/src/Game/Map.hs +++ b/src/Game/Map.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + module Game.Map ( Map (..), Object (..), @@ -16,8 +18,9 @@ where import Control.Applicative ((<|>)) import Control.Monad -import Data.List (find) -import Data.Maybe (fromMaybe, mapMaybe) +import Data.Maybe (fromMaybe) +import Data.Vector (Vector) +import qualified Data.Vector as Vector import Game.Entities.Types (Dir (..)) import qualified Game.Utils as U import SDL (($=)) @@ -34,15 +37,15 @@ data Tileset = Tileset height :: Int, firstGid :: Int, tilecount :: Int, - tiles :: [Tile] + tiles :: Vector Tile } deriving (Show) data Layer = TileLayer - {name :: String, tiles :: [Int]} + {name :: String, tiles :: Vector Int} | ObjectLayer - {name :: String, objects :: [Object]} + {name :: String, objects :: Vector Object} deriving (Show) data PropertyValue = PropertyValueBool Bool | PropertyValueInt Int | PropertyValueString String @@ -63,17 +66,21 @@ data Object data JsonMapData = JsonMapData { width :: Int, height :: Int, - tilesets :: [Tileset], - layers :: [Layer] + tilesets :: Vector Tileset, + layers :: Vector Layer } deriving (Show) newtype Frame = Frame Int deriving (Show) data Tile = Tile - {id :: Int, animation :: [Frame]} + {id :: Int, animation :: Vector Frame} deriving (Show) +instance JSON a => JSON (Vector a) where + showJSON = undefined + readJSON obj = fmap Vector.fromList (readJSON obj) + instance JSON Property where showJSON = undefined readJSON (JSObject obj) = do @@ -109,7 +116,7 @@ instance JSON Tileset where <*> valFromObj "tileheight" obj <*> valFromObj "firstgid" obj <*> valFromObj "tilecount" obj - <*> (valFromObj "tiles" obj <|> pure []) + <*> (valFromObj "tiles" obj <|> pure Vector.empty) readJSON _ = mzero instance JSON Layer where @@ -127,8 +134,8 @@ instance JSON Layer where -- Only takes into account the first "flip" property found. getPropertyDir :: JSObject JSValue -> Result Dir getPropertyDir obj = do - props <- valFromObj "properties" obj <|> pure [] - pure $ case find flipProp props of + props <- valFromObj "properties" obj <|> pure Vector.empty + pure $ case Vector.find flipProp props of Just _ -> DirLeft Nothing -> DirRight where @@ -171,10 +178,10 @@ instance JSON JsonMapData where data MapData = MapData { width :: Int, height :: Int, - tilesets :: [Tileset], - tileLayers :: [[Int]], - blocked :: [Int], - objects :: [Object] + tilesets :: Vector Tileset, + tileLayers :: Vector (Vector Int), + blocked :: Vector Int, + objects :: Vector Object } deriving (Show) @@ -201,11 +208,9 @@ load filename tex = do d <- readFile filename case decode d :: Result JsonMapData of Ok s -> do - let tileLayers = mapMaybe (filterTileLayer (\l -> l.name /= "Blocked")) s.layers - blockedLayers = mapMaybe (filterTileLayer (\l -> l.name == "Blocked")) s.layers - blockedLayer <- case blockedLayers of - [l] -> pure l - xs -> error $ "A single \"Blocked\" layer expected, " ++ show (length xs) ++ " found" + let tileLayers = Vector.mapMaybe (filterTileLayer (\l -> l.name /= "Blocked")) s.layers + blockedLayers = Vector.mapMaybe (filterTileLayer (\l -> l.name == "Blocked")) s.layers + blockedLayer <- Vector.headM blockedLayers pure $ Map MapData @@ -214,17 +219,17 @@ load filename tex = do tilesets = s.tilesets, tileLayers = tileLayers, blocked = blockedLayer, - objects = concat $ mapMaybe filterObjectLayer s.layers + objects = join $ Vector.mapMaybe filterObjectLayer s.layers } tex (MapState 0 0) Error e -> error e where - filterTileLayer :: (Layer -> Bool) -> Layer -> Maybe [Int] + filterTileLayer :: (Layer -> Bool) -> Layer -> Maybe (Vector Int) filterTileLayer f l = case l of TileLayer _ tiles -> if f l then Just tiles else Nothing _ -> Nothing - filterObjectLayer :: Layer -> Maybe [Object] + filterObjectLayer :: Layer -> Maybe (Vector Object) filterObjectLayer l = case l of ObjectLayer _ objs -> Just objs _ -> Nothing @@ -233,13 +238,13 @@ load filename tex = do -- x and y in pixels. isBlocked :: Map -> Int -> Int -> Bool isBlocked (Map (MapData mapWidth _ tilesets _ blocked _) _ _) x y = - blocked !! ((x `div` ts.width) + (y `div` ts.height) * mapWidth) >= ts.firstGid + blocked Vector.! ((x `div` ts.width) + (y `div` ts.height) * mapWidth) >= ts.firstGid where - ts = head tilesets + ts = Vector.head tilesets -- | Return the objects in a map. objects :: Map -> [Object] -objects (Map md _ _) = md.objects +objects (Map md _ _) = Vector.toList md.objects isPlayer :: Object -> Bool isPlayer (PlayerEntity _ _) = True @@ -247,7 +252,7 @@ isPlayer _ = False -- | Return the number of batteries in a map. totalBatteries :: Map -> Int -totalBatteries m = length $ filter isBattery (objects m) +totalBatteries (Map md _ _) = Vector.length $ Vector.filter isBattery (md.objects) where isBattery :: Object -> Bool isBattery (BatteryEntity _ _) = True @@ -261,7 +266,7 @@ viewport renderer (Map mapData _ _) vx vy vw vh offs = do SDL.rendererViewport renderer $= Just mapRect pure $ Viewport newx newy vw vh where - tileset = head mapData.tilesets + tileset = Vector.head mapData.tilesets mapWidth = mapData.width * tileset.width mapHeight = mapData.height * tileset.height @@ -282,19 +287,19 @@ viewport renderer (Map mapData _ _) vx vy vw vh offs = do -- Requires a Viewport from viewport. render :: SDL.Renderer -> Map -> Viewport -> IO () render renderer (Map mapData tex (MapState _ step)) (Viewport vx vy vw vh) = do - mapM_ + Vector.mapM_ ( \layer -> - mapM_ + Vector.mapM_ ( \(x, y) -> -- clipping because we draw one extra row/col because the scroll when (x < mapData.width && y < mapData.height) $ - renderTile x y (layer !! (x + (y * mapData.width))) + renderTile x y (layer Vector.! (x + (y * mapData.width))) ) index ) mapData.tileLayers where - tileset = head mapData.tilesets + tileset = Vector.head mapData.tilesets tileWidth = tileset.width tileHeight = tileset.height @@ -307,16 +312,16 @@ render renderer (Map mapData tex (MapState _ step)) (Viewport vx vy vw vh) = do drawHeight = vh `div` tileHeight -- we draw one extra row/col - index = [(x, y) | x <- [ox .. ox + drawWidth], y <- [oy .. oy + drawHeight]] + index = Vector.fromList [(x, y) | x <- [ox .. ox + drawWidth], y <- [oy .. oy + drawHeight]] -- XXX: performance of this? findTileset :: Int -> Maybe Tileset - findTileset tile = find (\t -> t.firstGid + t.tilecount > tile && t.firstGid <= tile) mapData.tilesets + findTileset tile = Vector.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 + findTile ts tile = case Vector.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) + Just (Tile _ frames) -> fmap (\(Frame i) -> i) frames Vector.! (step `mod` Vector.length frames) renderTile :: Int -> Int -> Int -> IO () renderTile x y tile = -- cgit v1.2.3