module Game.Map
  ( Map (..),
    Object (..),
    objects,
    load,
    render,
    isBlocked,
  )
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 deriving (Show)

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 (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

-- | 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)