module Game (main) where

import Control.Monad.Reader
import Data.IORef
import Data.Maybe (fromMaybe)
import Data.Text (pack)
import Foreign.C.Types (CInt)
import qualified Game.Controller as C
import qualified Game.Entities as E
import qualified Game.Map as M
import qualified Game.Sprites as S
import Game.Utils (isPressed)
import SDL (($=), ($~))
import qualified SDL
import qualified SDL.Image
import SDL.Vect (V2 (..))

name :: String
name = "Haskell gamedev [Space Platformer]"

gameWidth, gameHeight :: CInt
(gameWidth, gameHeight) = (320, 180)

gameScale :: CInt
gameScale = 3

windowWidth, windowHeight :: CInt
(windowWidth, windowHeight) = (gameWidth * gameScale, gameHeight * gameScale)

version :: String
version = "0.1.0"

data Env = Env
  { _window :: SDL.Window,
    _renderer :: SDL.Renderer,
    _canvas :: SDL.Texture,
    _fullscreen :: IORef Bool,
    _renderRect :: IORef (SDL.Rectangle CInt),
    _controls :: IORef C.Controls,
    _map :: M.Map,
    _sprites :: S.SpriteSheet,
    _entities :: IORef [E.Entity]
  }

defaultRenderRect :: SDL.Rectangle CInt
defaultRenderRect = SDL.Rectangle (SDL.P $ V2 0 0) (V2 windowWidth windowHeight)

main :: IO ()
main = do
  SDL.initialize [SDL.InitVideo]
  window <-
    SDL.createWindow
      (pack $ name ++ " " ++ version)
      SDL.defaultWindow {SDL.windowInitialSize = SDL.V2 windowWidth windowHeight}
  renderer <-
    SDL.createRenderer
      window
      (-1)
      SDL.RendererConfig
        { SDL.rendererType = SDL.AcceleratedVSyncRenderer,
          SDL.rendererTargetTexture = True
        }
  SDL.HintRenderScaleQuality $= SDL.ScaleNearest
  canvas <- SDL.createTexture renderer SDL.RGBA8888 SDL.TextureAccessTarget (V2 gameWidth gameHeight)
  fullscreen <- newIORef False
  renderRect <- newIORef defaultRenderRect
  tsTexture <- SDL.Image.loadTexture renderer "data/tiles.png"
  ssTexture <- SDL.Image.loadTexture renderer "data/sprites.png"
  controls <- newIORef C.init
  map' <- M.load "data/map.json" tsTexture
  sprites <- S.load "data/sprites.json" ssTexture
  entities <- newIORef ([] :: [E.Entity])
  player <- E.mkPlayer sprites 32 104 controls (M.isBlocked map')
  entities $~ (player :)
  runReaderT gameLoop (Env window renderer canvas fullscreen renderRect controls map' sprites entities)
  SDL.destroyWindow window
  SDL.quit

toggleFullscreen :: ReaderT Env IO ()
toggleFullscreen = do
  env <- ask
  let fullscreen = _fullscreen env
      renderRect = _renderRect env
      renderer = _renderer env
      window = _window env
  fullscreen $~ not
  fs <- SDL.get fullscreen
  let mode = if fs then SDL.FullscreenDesktop else SDL.Windowed
   in SDL.setWindowMode window mode

  vp <- if fs then SDL.get $ SDL.rendererViewport renderer else pure Nothing
  let newRenderRect = case vp of
        Nothing -> defaultRenderRect
        Just (SDL.Rectangle _ (V2 w h)) ->
          SDL.Rectangle (SDL.P $ V2 rx ry) (V2 rw rh)
          where
            scale = min (w `div` gameWidth) (h `div` gameHeight)
            rx = (w - (gameWidth * scale)) `div` 2
            ry = (h - (gameHeight * scale)) `div` 2
            rw = gameWidth * scale
            rh = gameHeight * scale
   in renderRect $= newRenderRect

gameLoop :: ReaderT Env IO ()
gameLoop = do
  env <- ask
  let renderer = _renderer env
      canvas = _canvas env
      renderRect = _renderRect env
      controls = _controls env
      map' = _map env
      entities = _entities env

  events <- map SDL.eventPayload <$> SDL.pollEvents

  -- F11 for fullscreen / windowed
  when (fromMaybe False $ isPressed SDL.KeycodeF11 events) toggleFullscreen

  -- ESC or close the window to quit
  let quit = fromMaybe False (isPressed SDL.KeycodeEscape events) || SDL.QuitEvent `elem` events
  unless quit $ do
    -- update controls
    controls $~ C.update events

    SDL.rendererRenderTarget renderer $= Just canvas
    SDL.clear renderer

    -- update entities filtering out the ones that have been destroyed
    updated <- liftIO $ fmap (filter (not . E.eDestroy)) (traverse (\e -> E.eUpdate e e) =<< readIORef entities)
    entities $= updated

    -- render map and entities
    void $ liftIO $ do
      M.render renderer map'
      traverse (E.render renderer) updated

    SDL.rendererRenderTarget renderer $= Nothing
    rect <- SDL.get renderRect
    SDL.copy renderer canvas Nothing (Just rect)

    SDL.present renderer

    gameLoop