aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2023-05-02 23:28:23 +0100
committerJuan J. Martinez <jjm@usebox.net>2023-05-02 23:28:23 +0100
commitb3bd745ce3950c63e3c32ed218a3b9091a2f8461 (patch)
tree3229e3eb294bb3d085d0922d3c889a2acbb5a0fe /src
parent9498ca54f65174d127bb2be56b666a4d4f0619a6 (diff)
downloadspace-plat-hs-b3bd745ce3950c63e3c32ed218a3b9091a2f8461.tar.gz
space-plat-hs-b3bd745ce3950c63e3c32ed218a3b9091a2f8461.zip
Use vector instead of list
Should be more performant, access O(1) to elements.
Diffstat (limited to 'src')
-rw-r--r--src/Game/Map.hs77
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 =