module Game.Map ( Map (..), Object (..), objects, totalBatteries, load, render, isBlocked, isPlayer, ) where import Control.Monad import Data.Maybe (mapMaybe) import qualified Game.Utils as U import qualified SDL import Text.JSON import Text.JSON.Types data Tileset = Tileset { cols :: Int, width :: Int, height :: Int, firstGid :: Int } deriving (Show) data Layer = TileLayer {name :: String, tiles :: [Int]} | ObjectLayer {name :: String, objects :: [Object]} deriving (Show) -- | The object types in the map. data Object = PlayerEntity Int Int | BatteryEntity Int Int | SlimeEntity Int Int deriving (Show, Eq, Ord) data JsonMapData = JsonMapData { width :: Int, height :: Int, tileset :: Tileset, layers :: [Layer] } deriving (Show) instance JSON Tileset where showJSON = undefined readJSON (JSArray [JSObject obj]) = do Tileset <$> valFromObj "columns" obj <*> valFromObj "tilewidth" obj <*> valFromObj "tileheight" obj <*> valFromObj "firstgid" obj readJSON _ = mzero instance JSON Layer where showJSON = undefined readJSON (JSObject obj) = case get_field obj "type" of Just "tilelayer" -> TileLayer <$> valFromObj "name" obj <*> valFromObj "data" obj Just "objectgroup" -> ObjectLayer <$> valFromObj "name" obj <*> valFromObj "objects" obj _ -> Error "unsupported layer type" readJSON _ = mzero instance JSON Object where showJSON = undefined readJSON (JSObject obj) = case get_field obj "name" of Just "Player" -> PlayerEntity <$> valFromObj "x" obj <*> valFromObj "y" obj Just "Battery" -> BatteryEntity <$> valFromObj "x" obj <*> valFromObj "y" obj Just "Slime" -> SlimeEntity <$> valFromObj "x" obj <*> valFromObj "y" obj Just (JSString (JSONString s)) -> Error $ "unsupported entity " ++ show s e -> Error $ "unsupported entity in " ++ show e readJSON _ = mzero instance JSON JsonMapData where showJSON = undefined readJSON (JSObject obj) = JsonMapData <$> valFromObj "width" obj <*> valFromObj "height" obj <*> valFromObj "tilesets" obj <*> valFromObj "layers" obj readJSON _ = mzero data MapData = MapData { width :: Int, height :: Int, tileset :: Tileset, tileLayers :: [[Int]], blocked :: [Int], objects :: [Object] } deriving (Show) data Map = Map MapData SDL.Texture -- | Loads a map from a JSON file. load :: String -> SDL.Texture -> IO Map 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" pure $ Map MapData { width = s.width, height = s.height, tileset = s.tileset, tileLayers = tileLayers, blocked = blockedLayer, objects = concat $ mapMaybe filterObjectLayer s.layers } tex Error e -> error e where filterTileLayer :: (Layer -> Bool) -> Layer -> Maybe [Int] filterTileLayer f l = case l of TileLayer _ tiles -> if f l then Just tiles else Nothing _ -> Nothing filterObjectLayer :: Layer -> Maybe [Object] filterObjectLayer l = case l of ObjectLayer _ objs -> Just objs _ -> Nothing -- | Check for collision detection vs "Blocked" TileLayer. -- x and y in pixels. isBlocked :: Map -> Int -> Int -> Bool isBlocked (Map (MapData mapWidth _ ts _ blocked _) _) x y = blocked !! ((x `div` ts.width) + (y `div` ts.height) * mapWidth) >= ts.firstGid -- | Return the objects in a map. objects :: Map -> [Object] objects (Map md _) = md.objects isPlayer :: Object -> Bool isPlayer (PlayerEntity _ _) = True isPlayer _ = False -- | Return the number of batteries in a map. totalBatteries :: Map -> Int totalBatteries m = length $ filter isBattery (objects m) where isBattery :: Object -> Bool isBattery (BatteryEntity _ _) = True isBattery _ = False -- | Renders a map. render :: SDL.Renderer -> Map -> IO () render renderer (Map mapData tex) = do mapM_ ( \layer -> mapM_ ( \(x, y) -> renderTile x y $ layer !! (x + (y * mapData.width)) ) index ) mapData.tileLayers where index = [(x, y) | x <- [0 .. mapData.width - 1], y <- [0 .. mapData.height - 1]] columns = mapData.tileset.cols firstgid = mapData.tileset.firstGid tileWidth = mapData.tileset.width tileHeight = mapData.tileset.height renderTile :: Int -> Int -> Int -> IO () renderTile x y tile | tile < firstgid = pure () | otherwise = do let tx = (tile - firstgid) `rem` columns ty = (tile - firstgid) `div` columns src = U.rect (tx * tileWidth) (ty * tileHeight) tileWidth tileHeight dst = U.rect (x * tileWidth) (y * tileHeight) tileWidth tileHeight SDL.copy renderer tex (Just src) (Just dst)