Use vector instead of list

Should be more performant, access O(1) to elements.

1 files 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 =